Private Sub CopyFiles(ByVal SourceFolder As String, ByVal TargetFolder As String, _
ByVal FileType As String, ByVal InSub As Boolean)
Dim fsoFile As Object, fsoFolder As Object, SubFolder
Dim FileName As String, TargetFile As String, sExt As String
Dim dDat1 As Double, dDat2 As Double
FileType = Replace(FileType, " ", "")
FileType = ";" & FileType & ";"
With CreateObject("Scripting.FileSystemObject")
Set fsoFolder = .GetFolder(SourceFolder)
For Each fsoFile In fsoFolder.Files
dDat2 = 0
FileName = fsoFile.Path
sExt = .GetExtensionName(FileName)
If InStr(1, FileType, ";" & sExt & ";", vbTextCompare) Then
TargetFile = .BuildPath(TargetFolder, fsoFile.Name)
dDat1 = fsoFile.DateLastModified
If .FileExists(TargetFile) Then dDat2 = .GetFile(TargetFile).DateLastModified
If dDat1 > dDat2 Then .CopyFile FileName, TargetFile, True
End If
Next fsoFile
If InSub Then
For Each SubFolder In fsoFolder.subFolders
CopyFiles SubFolder.Path, TargetFolder, FileType, True
Next SubFolder
End If
End With
ExitSub:
End Sub
Sub Main()
Dim SourceFolder As String, TargetFolder As String
Dim bChk1 As Boolean, bChk2 As Boolean
With Application.FileDialog(4)
.AllowMultiSelect = False
If .Show = -1 Then
SourceFolder = .SelectedItems(1)
bChk1 = True
End If
End With
If bChk1 Then
With Application.FileDialog(4)
.AllowMultiSelect = False
If .Show = -1 Then
TargetFolder = .SelectedItems(1)
bChk2 = True
End If
End With
If bChk2 Then CopyFiles SourceFolder, TargetFolder, "[COLOR=#ff0000]xlsm;jpg[/COLOR]", True
End If
End Sub
