我正在使用下面的宏将一些工作表导入文件,然后以新名称将文件保存在其他位置。该宏可以很好地运行约40次迭代(它被设置为遍历几百个文件夹,并分别合并每个文件夹中的文件),然后失败。有时会出现“内存不足”错误(不可能是这种情况,我正在使用具有32GB RAM且这些文件不大的PC),有时宏会随机退出而没有错误,有时我在此行上收到错误:Set Wkb3 = Workbooks.Open(filename:=Path & "\" & filename)
这是我的宏:
Option Explicit
Sub CombineFiles()
Call NewBook 'this marco creates a new file that will hold the imported sheets
Dim Wkb1 As Workbook 'Wkb with Macro
Set Wkb1 = ThisWorkbook
Dim Aname As String
Aname = Wkb1.Sheets(1).Range("A1").Value & "\Master File\Master File.xlsx" 'cell A1 holds the path for each individual folder that holds files that need to be combined
Dim Wkb2 As Workbook 'MasterBook
Set Wkb2 = Workbooks.Open(filename:=Aname)
Dim Wkb3 As Workbook 'DataSource
Dim ws1 As Worksheet 'Wkb with Macro
Set ws1 = Wkb1.Worksheets(1)
Dim ws3 As Worksheet 'DataSource
Dim MyOldName As String
MyOldName = Wkb2.FullName
Dim Path As String
Path = ws1.Range("A1").Value
Dim filename As String
filename = Dir(Path & "\*.xlsx", vbNormal)
Dim Path2 As String
Dim filename2 As String
Path2 = Path & "\Master File\"
Do Until filename = ""
Set Wkb3 = Workbooks.Open(filename:=Path & "\" & filename)
For Each ws3 In Wkb3.Worksheets
ws3.Copy after:=Wkb2.Sheets(Wkb2.Sheets.Count)
Next ws3
Wkb3.Close False
filename = Dir()
Loop
Application.DisplayAlerts = False
filename2 = Wkb2.Worksheets(2).Range("A2").Text
Wkb2.SaveAs filename:=Path & filename & ".xlsx"
Wkb2.Close True
Kill MyOldName
Call KillFiles
Application.DisplayAlerts = True
End Sub
任何帮助将不胜感激。
将代码从filename = Dir()
更改为filename = Dir
就可以了!