Option Explicit
Option Compare Text
Public Sub Test()
Dim objFso As Object
Dim strFolderSrc As String
Dim strFolderDst As String
strFolderSrc = "D:\SourceFolder"
strFolderDst = "G:\DestinationFolder"
Set objFso = CreateObject("Scripting.FileSystemObject")
If Not objFso.FolderExists(strFolderSrc) Then
Call MsgBox("Source folder '" & strFolderSrc & "' does not exist.", vbExclamation)
Exit Sub
End If
If Not objFso.FolderExists(strFolderDst) Then
Call MsgBox("Destination folder '" & strFolderDst & "' does not exist.", vbExclamation)
Exit Sub
End If
Dim rngCell As Excel.Range
With Worksheets("Fundus")
.Range("A1:B1").Font.Bold = True
.Range("A1:B1").Value = Array("[Filename]", "[CopiedFrom]")
Set rngCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
End With
Dim objFileSrc As Object
For Each objFileSrc In objFso.GetFolder(strFolderSrc).Files
If "pdf" = objFso.GetExtensionName(objFileSrc.Name) Then
If Not FileAlreadyCopied(objFileSrc, objFso) Then
Call objFileSrc.Copy(strFolderDst)
rngCell.Value = objFso.GetBaseName(objFileSrc.Name)
rngCell.Offset(0, 1).Value = objFileSrc.ParentFolder.Path
Set rngCell = rngCell.Offset(1)
End If
End If
Next
Set rngCell = Nothing
Set objFileSrc = Nothing
Set objFso = Nothing
End Sub
Public Function FileAlreadyCopied(File As Object, Fso As Object) As Boolean
End Function