Copy PDF from source folder to destination folder - excel

Question

I want copy pdf from source folder and have to paste in destpath based on Excel, help me where I am gone wrong
Sub CheckandSend()
Dim irow As Integer
Dim DestPath As String
Dim SourcePath As String
Dim pfile As String
Dim FSO As Object
Dim Fldr As Object, f As Object
SourcePath = "I:\Mechanical\ExternalProjects\Cummins Emission Systems\35101124 PT Cup Test Rig\16 PDF to Vendor"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Fldr = FSO.GetFolder(SourcePath).Files
DestPath = "P:\CENTRAL PLANNING\PROJECTS 2020-2021\VAM-TARSON\Newfolder1"
irow = 7
Do While Cells(irow, 2) <> Empty
pfile = Dir(SourcePath & "\*" & Cells(irow, 2) & "*")
If pfile <> "" And Right(pfile, 3) = "PDF" Then
FileCopy SourcePath, DestPath
irow = irow + 1
End If
Loop
end sub

Answer 1

You are mixing 2 different methods: The FileSystemObject and Dir(). Only use one of them.
FileCopy SourcePath, DestPath only copies the path but there is no filename.
Directly include the file extension in your Dir() so you don't need to check for pdf files:
FileName = Dir(SourcePath & "*" & ws.Cells(iRow, 2) & "*.pdf")
There may exist more than one file with the key word from your cell. Your code copies randomly one of them. Make sure to loop so you get all of them
Do While FileName <> vbNullString 'if more files with the key word from ws.Cells(iRow, 2) exist copy all of them
VBA.FileCopy SourcePath & pfile, DestPath 'copy needs to be path AND filename
FileName = Dir()
Loop
It could look like this:
Option Explicit
Public Sub CheckandSend()
Dim ws As Worksheet 'make sure to define a sheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim SourcePath As String
SourcePath = "C:\Temp\" 'make sure paths end with \
Dim DestPath As String
DestPath = "P:\CENTRAL PLANNING\PROJECTS 2020-2021\VAM-TARSON\Newfolder1\" 'make sure paths end with \
Dim iRow As Long
iRow = 7
Do While ws.Cells(iRow, 2) <> vbNullString
Dim FileName As String
FileName = Dir(SourcePath & "*" & ws.Cells(iRow, 2) & "*.pdf") 'this will only go through pdf files
Do While FileName <> vbNullString 'if more files with the key word from ws.Cells(iRow, 2) exist copy all of them
VBA.FileCopy SourcePath & pfile, DestPath 'copy needs to be path AND filename
FileName = Dir()
Loop
iRow = iRow + 1
Loop
End Sub

Answer 2

The code below works.
Sub CheckandSend()
' 191
Const Ext As String = ".pdf"
Dim SourcePath As String
Dim DestPath As String
Dim FSO As Object
Dim Fldr As Object
Dim pFile As String
Dim f As Object
Dim iRow As Long ' row numbers should be declared as Long
' both paths must end on backslash ("\")
SourcePath = "I:\Mechanical\ExternalProjects\Cummins Emission Systems\35101124 PT Cup Test Rig\16 PDF to Vendor\"
DestPath = "P:\CENTRAL PLANNING\PROJECTS 2020-2021\VAM-TARSON\Newfolder1\"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Fldr = FSO.GetFolder(SourcePath).Files
' loop until last used cell in column B
For iRow = 7 To Cells(Rows.Count, 2).End(xlUp).Row
pFile = Trim(Cells(iRow, 2).Value)
If Len(pFile) = 0 Then Exit For ' exit at first blank row
If LCase(Right(pFile, 4)) <> Ext Then pFile = pFile & Ext
If Len(Dir(SourcePath & pFile)) Then
FileCopy SourcePath & pFile, DestPath & pFile
End If
Next iRow
End Sub
There are a few inconsistencies in your procedure which I have eliminated. For example, your code isn't clear whether the file name in the worksheet has a pdf extension or not, then looks for any file by that name but rejects all that aren't "pdf". The above code rephrases this to mean that you want a PDF file by the name in the worksheet and any file by the same name but another extension is to be ignored. It's the same, I think, but more efficient if you limit the search to PDF.
The other thing is the end of the loop. Is it when there are no more file names or when a cell is blank? The above code ends in either case. I presume that is OK because there are no blanks in your list of files. If so, it would be better, however, to just skip any accidental blanks and continue until the last line has been processed. If you agree, delete the Exit For and set an End If at the appropriate point (before the Next iRow) and indent all lines in between.