VBA Excel中的应用程序错误

本文介绍了VBA Excel中的应用程序错误的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述 我有一个运行时错误'1004'：应用程序 - 我的代码定义或对象定义的错误。 Sub simpleXlsMerger（） Dim bookList As 工作簿 Dim mergeObj 作为 对象，dirObj 作为 对象，filesObj As 对象，everyObj 作为 对象 Application.ScreenUpdating = False 设置 mergeObj = CreateObject（ Scripting.FileSystemObject） Dim strWSName 作为 字符串 strWSName = InputBox（ 输入要合并的Excel文件的文件路径） 如果 strWSName<> 然后 ' 更改Excel文件的文件夹路径 设置 dirObj = mergeObj.GetFolder（strWSName） ' header 范围（ A1）。Value = 项目 范围（ B1）。值= 描述 范围（ C1）。值= 质量 设置 fileObj = dirObj.Files 对于 每个 everyObj 在 fileObj 设置 bookList = Workbooks.Open（everyObj） Dim rayong 作为 整数，苏州作为 Integer ，shenyang as Integer ，japan 作为 整数 rayong = InStr（ 1 ，everyObj， RAYONG，vbTextCompare）苏州= InStr（ 1 ，everyObj， SZ，vbTextCompare） shenyang = InStr（ 1 ，everyObj， 沉阳，vbTextCompare） ' 注意：仍然不知道文件是否格式正确 japan = InStr（ 1 ，everyObj， JPN，vbTextCompare） 如果 rayong = 95 那么 ' 更改A2，此处包含每个文件的起始点的单元格引用 ' 例如B3：IV合并所有文件从列B和行3开始 ' 如果您使用的文件超过IV列，请将其更改为最新列 ' 同时将A65536上的A列更改为与起点相同的列 范围（ A2：IV&范围（ A65536）。结束 （xlUp）.Row）。复制 ThisWorkbook.Worksheets（ 1 ）。激活 ' 请勿更改以下列。它与上面的列不同 范围（ A65536）。 结束（xlUp）。偏移（ 1 ， 0 ）。PasteSpecial ' 注意：应用程序错误?? ElseIf suzhou = 100 然后 Workbooks.Open（everyObj）。激活范围（ B2：B & Range（ A65536）。 End （xlUp）.Row）。复制 ThisWorkbook.Worksheets（ 1 ）。激活范围（ A65536）。结束（xlUp）。偏移量（ 1 ， 0 ）。PasteSpecial Workbooks.Open（everyObj）。激活范围（ I2：I&范围（ A65536）。结束 （xlUp）.Row）。复制 ThisWorkbook.Worksheets（ 1 ）。激活范围（ B65536）。结束（xlUp）.Offset（ 1 ， 0 ）。PasteSpecial Workbooks.Open（everyObj）.Activate Range（ H2：H& Range（ A65536）。结束（xlUp）.Row）。复制 ThisWorkbook.Worksheets（ 1 ）。激活范围（ C65536）。 End （xlUp）.Offset（ 1 ， 0 ）。 PasteSpecial ' 注意：应用程序错误?? ElseIf shenyang = 95 然后 ActiveWorkbook .Sheets（ WMSInventory）。激活范围（ A2：A&范围（ A65536）。结束 （xlUp）.Row）。复制 ThisWorkbook.Worksheets（ 1 ）。激活范围（ A65536）。结束（xlUp）.Offset（ 1 ， 0 ）。PasteSpecial ActiveWorkbook.Sheets（ WMSInventory）。激活范围（ B2：B& Range（ A65536）。结束（xlUp）.Row）。复制 ThisWorkbook.Worksheets（ 1 ）。激活范围（ B65536）。结束（ xlUp ）.Offset（ 1 ， 0 ）。PasteSpecial ActiveWorkbook.Sheets（ WMSInventory）。激活范围（ D2：D&范围（ A65536）。结束 （xlUp）.Row）。复制 ThisWorkbook.Worksheets（ 1 ）。激活范围（ D65536）。结束（xlUp）.Offset（ 1 ， 0 ）。PasteSpecial ' 注意：应用程序错误?? ElseIf japan = 88 然后 Workbooks.Open（everyObj）。激活范围（ A2：& Range（ A65536）。结束（xlUp）.Row）。复制 ThisWorkbook.Worksheets（ 1 ）。激活范围（ A65536).结束（xlUp）.Offset（ 1 ， 0 ）。PasteSpecial Workbooks.Open（everyObj）。激活范围（ O2：O&范围（ A65536）。结束 （xlUp）.Row）。复制 ThisWorkbook.Worksheets（ 1 ）。激活范围（ B65536）。结束（xlUp）.Offset（ 1 ， 0 ）。PasteSpecial Workbooks.Open（everyObj）.Activate Range（ B2：B& Range（ A65536）。结束（xlUp）.Row）。复制 ThisWorkbook.Worksheets（ 1 ）。激活范围（ C65536）。 End （xlUp）.Offset（ 1 ， 0 ）。 PasteSpecial 结束 如果 Application.CutCopyMode = False bookList.Close ' < ---- if条件后出现错误。 下一步 其他 MsgBox 没有FilePath提供！重新打开此excel以放置完整的文件路径。 结束 如果 结束 Sub 请帮忙。:( 解决方案 基本上你在行上设置错误设置bookList = Workbooks.Open（everyObj）.. 在集合fileObj中，您拥有所有类型的文件，甚至是隐藏的文件，这些文件可能是只读的并且尝试打开此类文件会导致错误，因此请更新解决方案以使用所需类型的文件填充集合仅 I have a run-time error '1004': Application - defined or object-defined error with my codes.Sub simpleXlsMerger()Dim bookList As WorkbookDim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As ObjectApplication.ScreenUpdating = FalseSet mergeObj = CreateObject("Scripting.FileSystemObject")Dim strWSName As StringstrWSName = InputBox("Enter the file path of Excel Files to merge")If strWSName <> "" Then 'change folder path of excel files here Set dirObj = mergeObj.GetFolder(strWSName) 'header Range("A1").Value = "Item" Range("B1").Value = "Description" Range("C1").Value = "Quality" Set fileObj = dirObj.Files For Each everyObj In fileObj Set bookList = Workbooks.Open(everyObj) Dim rayong As Integer, suzhou As Integer, shenyang As Integer, japan As Integer rayong = InStr(1, everyObj, "RAYONG", vbTextCompare) suzhou = InStr(1, everyObj, "SZ", vbTextCompare) shenyang = InStr(1, everyObj, "Shenyang", vbTextCompare) 'Note: Still do not know if file has the right format japan = InStr(1, everyObj, "JPN", vbTextCompare) If rayong = 95 Then 'change "A2" with cell reference of start point for every files here 'for example "B3:IV" to merge all files start from columns B and row 3 'If you're files using more than IV column, change it to the latest column 'Also change "A" column on "A65536" to the same column as start point Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets(1).Activate 'Do not change the following column. It's not the same column as above Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial 'Notes: Application Error?? ElseIf suzhou = 100 Then Workbooks.Open(everyObj).Activate Range("B2:B" & Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets(1).Activate Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Workbooks.Open(everyObj).Activate Range("I2:I" & Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets(1).Activate Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial Workbooks.Open(everyObj).Activate Range("H2:H" & Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets(1).Activate Range("C65536").End(xlUp).Offset(1, 0).PasteSpecial 'Notes: Application Error?? ElseIf shenyang = 95 Then ActiveWorkbook.Sheets("WMSInventory").Activate Range("A2:A" & Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets(1).Activate Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial ActiveWorkbook.Sheets("WMSInventory").Activate Range("B2:B" & Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets(1).Activate Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial ActiveWorkbook.Sheets("WMSInventory").Activate Range("D2:D" & Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets(1).Activate Range("D65536").End(xlUp).Offset(1, 0).PasteSpecial 'Notes: Application Error?? ElseIf japan = 88 Then Workbooks.Open(everyObj).Activate Range("A2:A" & Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets(1).Activate Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Workbooks.Open(everyObj).Activate Range("O2:O" & Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets(1).Activate Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial Workbooks.Open(everyObj).Activate Range("B2:B" & Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets(1).Activate Range("C65536").End(xlUp).Offset(1, 0).PasteSpecial End If Application.CutCopyMode = False bookList.Close '<---- Error appears here after an if condition. NextElse MsgBox "No FilePath Provided! Re-Open this excel to put complete filepath."End IfEnd SubPlease help. :( 解决方案 Basically u r getting an error at line "Set bookList = Workbooks.Open(everyObj)" .. In collection fileObj, you have got all sort of files, even the hidden ones which could be readonly and trying to open such files leads to error, so please update the solution to populate the collection with required type of files only. 这篇关于VBA Excel中的应用程序错误的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！