Copy Folder like Windows Explorer based on Date Modified

[gal4y]

I am using the code below to backup certain folders/files quickly. It works perfectly but it copies the all files, folders and sub-folders within a source directory to a destination directory but I would like to only copy those files based on some file date modified parameter. Where and how would I insert code to check if the files fall into the date modified parameter before copying it.

The initial routine is called "TransferFile" and I call that by sending it the source, destination and whether to Move or Copy (e.g., Call TransferFile(FromPath, ToPath, False)).

Thank you for any assistance in advance




_________________________________________

Option Explicit
' Below is for Launching the Control Panel
Public Declare Function GetDesktopWindow Lib "user32.dll" () As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'API constants
Public Const SW_SHOWNORMAL = 1

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2


Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

' Below is used for Copying files
Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As Any) As Long

Public Declare Sub SHFreeNameMappings Lib "shell32.dll" (ByVal hNameMappings As Long)

' Used for both Call types
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As FO_Functions
pFrom As String
pTo As String
fFlags As FOF_Flags
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String 'only used if FOF_SIMPLEPROGRESS
End Type

Public Enum FO_Functions
FO_MOVE = &H1
FO_COPY = &H2
FO_DELETE = &H3
FO_RENAME = &H4
End Enum

Public Enum FOF_Flags
FOF_MULTIDESTFILES = &H1
FOF_CONFIRMMOUSE = &H2
FOF_SILENT = &H4
FOF_RENAMEONCOLLISION = &H8
FOF_NOCONFIRMATION = &H10
FOF_WANTMAPPINGHANDLE = &H20
FOF_ALLOWUNDO = &H40
FOF_FILESONLY = &H80
FOF_SIMPLEPROGRESS = &H100
FOF_NOCONFIRMMKDIR = &H200
FOF_NOERRORUI = &H400
FOF_NOCOPYSECURITYATTRIBS = &H800
FOF_NORECURSION = &H1000
FOF_NO_CONNECTED_ELEMENTS = &H2000
FOF_WANTNUKEWARNING = &H4000
End Enum

Public Type SHNAMEMAPPING
pszOldPath As String
pszNewPath As String
cchOldPath As Long
cchNewPath As Long
End Type

' Below is for checking File versions
Private Declare Function GetLocaleInfoA Lib "kernel32.dll" (ByVal lLCID As Long, ByVal lLCTYPE As Long, ByVal strLCData As String, ByVal lDataLen As Long) As Long
Private Declare Sub lstrcpyn Lib "kernel32.dll" (ByVal strDest As String, ByVal strSrc As Any, ByVal lBytes As Long)
Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal sFile As String, lpLen As Long) As Long
Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" (ByVal sFile As String, ByVal lpIgnored As Long, ByVal lpSize As Long, ByVal lpBuf As Long) As Long
Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (ByVal lpBuf As Long, ByVal szReceive As String, lpBufPtr As Long, lLen As Long) As Long
Private Declare Function GetUserDefaultLCID Lib "kernel32.dll" () As Long
Private Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long, ByVal pv As String)

Private Const MASTER_DRIVE = "APP5-DC-PLTTire SpecCardexesNon-Tuber Cardex SP1a"
Private Const MASTER_DB_DRIVE = "APP5-DC-PLTTire SpecCardexesCardex Database Files"


Public Function SHFileOP(ByRef lpFileOp As SHFILEOPSTRUCT) As Long
'This uses a method suggested at MSKB to
'ensure that all parameters are passed correctly
'Call this wrapper rather than the API function directly
Dim result As Long
Dim lenFileop As Long
Dim foBuf() As Byte

lenFileop = LenB(lpFileOp)
ReDim foBuf(1 To lenFileop) 'the size of the structure.

'Now we need to copy the structure into a byte array
Call CopyMemory(foBuf(1), lpFileOp, lenFileop)

'Next we move the last 12 bytes by 2 to byte align the data
Call CopyMemory(foBuf(19), foBuf(21), 12)
result = SHFileOperation(foBuf(1))

SHFileOP = result
End Function

Public Function StringFromBuffer(buffer As String) As String
Dim nPos As Long

nPos = InStr(buffer, vbNullChar)
If nPos > 0 Then
StringFromBuffer = Left$(buffer, nPos - 1)
Else
StringFromBuffer = buffer
End If
End Function

Public Sub TransferFileToRecycleBin(Filename As String, Optional Confirm As Boolean = False, Optional Silent As Boolean = True)
Dim FileOp As SHFILEOPSTRUCT
'fills the file operation structure
With FileOp
.wFunc = FO_DELETE
.pFrom = Filename
'.fFlags = FOF_ALLOWUNDO
If Not Confirm Then .fFlags = .fFlags + FOF_NOCONFIRMATION
If Silent Then .fFlags = .fFlags + FOF_SILENT
End With
SHFileOperation FileOp
End Sub

Public Sub TransferFile(ByVal Source As String, ByVal Destination As String, Optional ByVal bMove As Boolean = False)
Dim lRet As Long
Dim FileOp As SHFILEOPSTRUCT
Dim result As Long
With FileOp
.hwnd = 0
If bMove Then
.wFunc = FO_MOVE
Else
.wFunc = FO_COPY
End If
.pFrom = Source & vbNullChar & vbNullChar
.pTo = Destination & vbNullChar & vbNullChar
.lpszProgressTitle = "Transfering..."
.fFlags = FOF_NOCONFIRMATION
End With

lRet = SHFileOP(FileOp)

If result <> 0 Then 'Operation failed
MsgBox Err.LastDllError 'Show the error returned from the API.
Else
If FileOp.fAnyOperationsAborted <> 0 Then
MsgBox "Operation Failed"
End If
End If
End Sub

 

[UnsolvedCoding]

This is something I put together for a similar situation. You will need to modify it, but it works and the original conversation is a thread in which several people had ideas.
Also be sure to use the scripting reference.

Option Explicit

Sub FileList()

' To update this sub for different forms and folders
' Look for the row of ************** and alter code as needed

Dim Test1 As String

Dim I As Long

Dim F

Dim myFS As Scripting.FileSystemObject
Set myFS = New Scripting.FileSystemObject
Dim myFolder As Folder

'*************************************************
' Update this line to the folder path you want to search
Set myFolder = myFS.GetFolder("C:\My_Folder")

I = 2
For Each F In myFolder.Files

Application.StatusBar = "Row " & I

'*************************************************
' If you want to search subfolders use this line
'f.SearchSubFolders = True

' This returns the files path with the name and ext
ThisWorkbook.Sheets("Sheet1").Range("A" & I).Value = F.Path

' To get the last modified date use one of these
'ThisWorkbook.Sheets("Contains").Range("B" & I).Value = f.Name & ":" & Left(f.DateLastModified, 10)
'ThisWorkbook.Sheets("Contains").Range("B" & I).Value = f.Name & ":" & f.DateLastModified
'ThisWorkbook.Sheets("Contains").Range("B" & I).Value = f.DateLastModified

I = I + 1

End If

Next

MsgBox "Done"

End Sub