VBA Copying Newer Files from one location to another using SHFileOperation - ms-access

Question

I have this code to copy files from one location to another in Access 2010 and is working fine. The problem I'm having is copying just the new files to the destination. I do not want to override the files, only copy new files.
Here is my code:
Public Declare Function SHFileOperation Lib "shell32.dll" _
Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Const FO_COPY = &H2
Private Const FO_DELETE = &H3
Private Const FO_MOVE = &H1
Private Const FO_RENAME = &H4
Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_CONFIRMMOUSE = &H2
Private Const FOF_CREATEPROGRESSDLG = &H0
Private Const FOF_FILESONLY = &H80
Private Const FOF_MULTIDESTFILES = &H1
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_NOCONFIRMMKDIR = &H200
Private Const FOF_RENAMEONCOLLISION = &H8
Private Const FOF_SILENT = &H4
Private Const FOF_SIMPLEPROGRESS = &H100
Private Const FOF_WANTMAPPINGHANDLE = &H20
Public Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As Long
End Type
Public Sub VBCopyFolder(ByRef strSource As String, ByRef strTarget As String)
Dim op As SHFILEOPSTRUCT
With op
.wFunc = FO_COPY
.pTo = strTarget
.pFrom = strSource
.fFlags = FOF_SIMPLEPROGRESS
End With
'~~> Perform operation
SHFileOperation op
End Sub
I call the subroutine like so
Call VBCopyFolder("O:\fieldticket\pdf\", "\\rwmain01\gis\FieldTicket\")

Answer 1

Here is one option you can try. You will have to iterate through the files though. So, it will potentially be slow over time if you have a large number of files building up.
Public Sub CopyFiles()
Dim fso As Scripting.FileSystemObject
Dim fld As Scripting.Folder
Dim fils As Scripting.Files
Dim fil As Scripting.File
Dim strSourceFolder As String
Dim strDestFolder As String
Dim strFileName As String
On Error GoTo err_Proc
Set fso = CreateObject("Scripting.FileSystemObject")
strSourceFolder = "O:\fieldticket\pdf\"
strDestFolder = "\\rwmain01\gis\FieldTicket\"
If Not fso.FolderExists(strSourceFolder) Then GoTo exit_Proc
Set fld = fso.GetFolder(strSourceFolder)
For Each fil In fld.Files
' Process the file with logic you consider new
If fil.DateCreated > Now - 1 Then
fso.CopyFile fil.Path, strDestFolder & fil.Name
DoEvents
End If
' Or just try to copy it over with overwrite set to false
'fso.CopyFile fil.Path, strDestFolder & fil.Name, False
Next
exit_Proc:
Set fil = Nothing
Set fils = Nothing
Set fld = Nothing
Set fso = Nothing
Exit Sub
err_Proc:
Debug.Print Err.Description
GoTo exit_Proc
End Sub