下面的代码收集自vbaexpress.com，可以将源文件夹中的最新文件复制到另一个文件夹。代码运行后，弹出一个对话框告诉用户选择源文件夹，选好后，单击“确定”，会弹出另一个对话框告诉用户选择目标文件夹，单击“确定”，源文件夹中的最新文件将被复制到目标文件夹中。
VBA代码如下：
代码语言：javascript复制Dim FileNames() As Variant
Dim FSO As Object
Dim FileCounter As Long
Const FinalFileName As String = "LastFile" '将这个名字修改为你实际的名字
Sub MoveRecentFile()
Dim FD As FileDialog
Dim IsSourceFolSelected As Boolean
Dim IsTargetFolSelected As Boolean
Dim SourceFolderPath As String
Dim RecentDate As Date
Dim RecentFileName As String
Dim x As Long
Dim Fil As Object
Dim TargetFolderPath As String
Set FD = Application.FileDialog(msoFileDialogFolderPicker)
Do While IsSourceFolSelected = False Or IsTargetFolSelected = False '检查源文件夹和目标文件夹是否都已选择
If IsSourceFolSelected = False Then
FD.Title = "选择源文件夹"
IsSourceFolSelected = FD.Show
If Not IsSourceFolSelected = False Then
SourceFolderPath = FD.SelectedItems(1)
IsSourceFolSelected = True
End If
End If
If IsTargetFolSelected = False Then
FD.Title = "选择目标文件夹"
IsTargetFolSelected = FD.Show
If Not IsTargetFolSelected = False Then
TargetFolderPath = FD.SelectedItems(1)
IsTargetFolSelected = True
End If
End If
Loop
Set FSO = CreateObject("Scripting.FileSystemObject")
FileCounter = 1
Call LoopOverFoldersAndSubFolders(SourceFolderPath, False) '如果想遍历文件夹中的子文件夹, 则将参数修改为True
RecentDate = FileNames(2, 1)
'检查最近日期
For x = 1 To UBound(FileNames, 2)
If FileNames(2, x) > RecentDate Then
RecentDate = FileNames(2, x)
RecentFileName = FileNames(1, x)
End If
Next x
Set Fil = FSO.GetFile(RecentFileName)
Fil.Copy TargetFolderPath & "\" & FinalFileName & "." & FSO.GetExtensionName(Fil.Name)
Set FSO = Nothing
Erase FileNames
End Sub
Private Sub LoopOverFoldersAndSubFolders(SourceFolderPath As String, Optional LoopOverSubFolder As Boolean = False)
Dim SourceFolder As Object
Dim SubFol As Object
Dim Fil As Object
Set SourceFolder = FSO.GetFolder(SourceFolderPath)
For Each Fil In SourceFolder.Files
ReDim Preserve FileNames(1 To 2, 1 To FileCounter)
FileNames(1, FileCounter) = Fil.Path
FileNames(2, FileCounter) = Fil.DateLastModified
FileCounter = FileCounter + 1
Next Fil
If LoopOverSubFolder = True Then
For Each SubFol In SourceFolder.SubFolders
Call LoopOverFoldersAndSubFolders(SubFol.Path, True)
Next SubFol
End If
End Sub欢迎在下面留言，完善本文内容，让更多的人学到更完美的知识。