VBA - Search files in folder, copy found files, return what files were not found

[Norbert94]

Hello,

What I am trying to achieve here is the following:

I have a column with filenames that includes the extension (in this case, .pdf) - these are plain values, not results of formulas
I'm trying to create a macro that loops through the column (that starts at B2), use the values on each row to search for the file in a predefined source folder - if found, it should copy the file to a predefined destination folder and, if not found, I would like it to write in the cell to the right "Not found", i.e if the file at B13 is not found, show the "Not found" message in cell C13.

This is the code I have:

Sub TestingN()

Dim sPath As String
Dim dPath As String
Dim fName As String
Dim ir As Long
ir = 2
Dim fso As FileSystemObject

Sheets("CE_Files").Activate

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose the source folder"
.InitialFileName = sPath
If Not .Show Then Exit Sub
sPath = .SelectedItems(1)
End With

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose the destination folder"
.InitialFileName = dPath
If Not .Show Then Exit Sub
dPath = .SelectedItems(1)
If Right(dPath, 1) <> "\" Then dPath = dPath & "\"
End With

fName = Cells(ir, 2)
Do While fName <> ""
If Dir(sPath & fName) <> "" Then
FileCopy sPath & fName, dPath & fName
Else: Cells(ir, 3) = "File Not Found"
End If
Loop


End Sub

It returns "File not found" for the first file, even though the file exists. And it the does not loop through the rest nor copy any of the files. Any suggestions?

Thanks!

 

[Norbert94]

I missed some steps there:

Sub TestingN()

Dim sPath As String
Dim dPath As String
Dim fName As String
Dim ir As Long
ir = 2
Dim fso As FileSystemObject

Sheets("CE_Files").Activate

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose the source folder"
.InitialFileName = sPath
If Not .Show Then Exit Sub
sPath = .SelectedItems(1)
End With

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose the destination folder"
.InitialFileName = dPath
If Not .Show Then Exit Sub
dPath = .SelectedItems(1)
If Right(dPath, 1) <> "\" Then dPath = dPath & "\"
End With

fName = Cells(ir, 2)
Do While fName <> ""
If Dir(sPath & fName) <> "" Then
FileCopy sPath & fName, dPath & fName
Else: If Not Dir(sPath & fName) <> "" Then Cells(ir, 3) = "File Not Found"
End If

ir = ir + 1
fName = Cells(ir, 2)

Loop


End Sub

Now it loops through all the values correctly, but it returns the "File not found" value to each of them, does not copy anything

 

[John_w]

Change:

sPath = .SelectedItems(1)

to:

sPath = .SelectedItems(1) & "\"

 

[Norbert94]

Change:


to:

sPath = .SelectedItems(1) & "\"

Thank you John! Everything works perfectly now