打开上次修改的文件并复制到上次修改的工作簿中

Question

我正在尝试执行以下操作：打开文件夹中上次修改的已保存XLS文件(仅包含1张(，然后将其复制到保存在另一个文件夹中的另一个上次修改工作簿的最后一张旁边。

不确定是否清楚，但如果需要，很乐意详细说明。目前，我正在使用以下代码，该代码肯定需要增强。

提前感谢您的帮助！

Sub CopyMonthlyData()
Dim sFldr As String
Dim fso As Scripting.FileSystemObject
Dim fsoFile As Scripting.File
Dim fsoFldr As Scripting.Folder
Dim dtNew As Date, sNew As String
Dim sFileName As String
Set fso = New Scripting.FileSystemObject
sFldr = "path"
Set fsoFldr = fso.GetFolder(sFldr)
For Each fsoFile In fsoFldr.Files
If fsoFile.DateLastModified > dtNew Then
sNew = fsoFile.Path
sFileName = fsoFile.Name
dtNew = fsoFile.DateLastModified
End If
Next fsoFile
Workbooks.Open Filename:=sNew
Sheets("Sheet1").Copy Before:=Workbooks("Book2.xlsm").Sheets(1)
Windows(sFileName).Activate
ActiveWindow.Close  

Answer 1

请测试下一个代码：

Sub CopyMonthlyData()
Dim strWbCopy As Variant, strWbDest As Variant, wbCopy As Workbook, wbDest As Workbook
Dim strCopyFoldPath As String, strDestFoldPath As String
strCopyFoldPath = "C:Teste VBA ExcelTari" 'put here the fodler path for the file to be copied
strDestFoldPath = "C:Teste VBA ExcelPDA"  'folder path for the destination file
strWbCopy = getLastModifFile(strCopyFoldPath)
strWbDest = getLastModifFile(strDestFoldPath)
Set wbCopy = Workbooks.Open(fileName:=strWbCopy)
Set wbDest = Workbooks.Open(fileName:=strWbDest)
wbCopy.Sheets(1).Copy Before:=wbDest.Sheets(1)
wbCopy.Close
End Sub
Function getLastModifFile(sFldr As String) As String
Dim fso As New Scripting.FileSystemObject
Dim fsoFile As Scripting.File, fsoFldr As Scripting.folder
Dim dtNew As Date, sNew As String, sFileName As String
Set fsoFldr = fso.GetFolder(sFldr)
For Each fsoFile In fsoFldr.Files
If fsoFile.DateLastModified > dtNew Then
sNew = fsoFile.path
sFileName = fsoFile.Name
dtNew = fsoFile.DateLastModified
End If
Next fsoFile
getLastModifFile = sNew
End Function

你只需要注意改变strCopyFoldPath，并用适当的路径strCopyFoldPath。并确保两个已处理文件夹中的所有文件都是.xls文件...否则，该函数还必须比较文件扩展名。

下一个函数不需要任何引用：

Function getLastModifFile(sFldr As String) As String
Dim fso As Object, fsoFile As Object, fsoFldr As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim dtNew As Date, sNew As String, sFileName As String
Set fsoFldr = fso.GetFolder(sFldr)
For Each fsoFile In fsoFldr.Files
If fsoFile.DateLastModified > dtNew Then
sNew = fsoFile.path
sFileName = fsoFile.Name
dtNew = fsoFile.DateLastModified
End If
Next fsoFile
getLastModifFile = sNew
End Function