[英]VBA: Run-Time Automation Error - “Code execution has been interrupted”
I'm attempting to write a program to loop through a directory of excel files and copy a range into a "Master Workbook". 我正在尝试编写一个程序以遍历excel文件目录,并将范围复制到“主工作簿”中。 When I run the program I am prompted with "Code execution has been interrupted".
运行程序时,系统提示“代码执行已中断”。 If I select continue the code will successfully run but then a "run-time error '-2147221080' Automation error" appears.
如果选择继续,代码将成功运行,但是会出现“运行时错误'-2147221080'自动化错误”。
The line that causes the error is: 导致错误的行是:
Set ws = wb.Worksheets("Project Log")
My question is, why is this line causing the error and or is there a way to bypass the error prompt so that my code will successfully run? 我的问题是,为什么这行会导致错误?或者有没有办法绕过错误提示,以便我的代码能够成功运行?
Sub FileCompiler()
Dim folderPath As String
Dim Filename As String
Dim wb As Workbook
Dim Masterwb As Workbook
Dim ws as Worksheet
'set workbook in which data will be copied to
Set Masterwb = ActiveWorkbook
'declare path
'folderPath = "C:MyPath\"
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
'compile directory data to master spreadsheet
Filename = Dir(folderPath & "*.xls*")
Do While Filename <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & Filename)
Set ws = wb.Worksheets("Project Log")
ws.Range(ws.Cells(2, "C"), ws.Cells(2, "C")).Copy
Masterwb.Worksheets("Staging").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
ws.Range(ws.Cells(7, "A"), ws.Cells(Rows.Count, "K").End(xlUp)).Copy
Masterwb.Worksheets("Staging").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
wb.Close True
Filename = Dir
Loop
Application.ScreenUpdating = True
End Sub
Dim Finfo As String
Dim FilterIndex As Long
Dim Title As String
Dim CopyBook As Workbook
Dim CopySheet As Worksheet
Dim ForecastFileName As Variant
Dim MasterSheet AS Worksheet
Set MasterSheet = ThisWorkbook.Worksheets("Yoursheetname")
'now you can always use master sheet after you set copybook
'Set up file filter
Finfo = "Excel Files (*.xls*),*.xls*"
'Set filter index to Excel Files by default in case more are added
FilterIndex = 1
' set Caption for dialogue box
Title = "Hey there!, select a file"
'get the Forecast Filename
ForecastFileName = Application.GetOpenFilename(Finfo, FilterIndex, Title)
'Change this according to what you need for workbook and worksheet names
Workbooks.Open (ForecastFileName)
Set CopyBook = ActiveWorkbook
Set CopySheet = CopyBook.Worksheets(1)
'Do your code, remember to close
CopyBook.Close savechanges:=False 'Not needed now
You might want to check for the ForecastFileName being False, that is when the users x's out, you will also want to do a little validation the wb sheet is in the right format by checking column headers ect or you will wind up crashing. 您可能要检查ForecastFileName是否为False,即当用户x不在时,您还需要通过检查列标题ect来对wb表的格式正确进行一点验证,否则将崩溃。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.