我有一个宏,它通过一个大型文件目录并执行任务。但是,当宏到达具有“不可读内容”的某个文件时,宏会停止。 (excel文件)
我可以在代码中添加哪些内容来跳过这些文件?我放置了哪些代码区域?
在我声明我的变量之后尝试将它添加到我的代码中,但是没有做任何事情。
On Error Resume Next
非常感谢
EDIT ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~
发布我的vba代码的一部分,只是一个注释:'UserInput'是一个函数。如果您需要更多帖子以便更好地了解,请告诉我,我会发布。
'get user input for files to search
Set fileNames = CreateObject("Scripting.Dictionary")
errCheck = UserInput.FileDialogDictionary(fileNames)
If errCheck Then
Exit Sub
End If
'''
For Each Key In fileNames 'loop through the dictionary
Debug.Print fileNames(Key)
Set wb = Workbooks.Open(fileNames(Key), CorruptLoad:=xlRepairFile)
wb.Application.Visible = False 'make it not visible
EDIT ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~
要上传完整代码。这是建议的更改。
Sub ladiesman()
'includes filling down
Dim wb As Workbook, fileNames As Object, errCheck As Boolean
Dim ws As Worksheet, wks As Worksheet, wksSummary As Worksheet
Dim y As Range, intRow As Long, i As Integer
Dim r As Range, lr As Long, myrg As Range, z As Range
Dim boolWritten As Boolean, lngNextRow As Long
Dim intColNode As Integer, intColScenario As Integer
Dim intColNext As Integer, lngStartRow As Long
Dim lngLastNode As Long, lngLastScen As Long
' Turn off screen updating and automatic calculation
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
' Create a new worksheet, if required
On Error Resume Next
Set wksSummary = ActiveWorkbook.Worksheets("Unique data")
On Error GoTo 0
If wksSummary Is Nothing Then
Set wksSummary = ActiveWorkbook.Worksheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
wksSummary.Name = "Unique data"
End If
' Set the initial output range, and assign column headers
With wksSummary
Set y = .Cells(.Rows.Count, 3).End(xlUp).Offset(1, 0)
Set r = y.Offset(0, 1)
Set z = y.Offset(0, -2)
lngStartRow = y.Row
.Range("A1:D1").Value = Array("File Name", "Sheet Name", "Node Name", "Scenario Name")
End With
'get user input for files to search
Set fileNames = CreateObject("Scripting.Dictionary")
errCheck = UserInput.FileDialogDictionary(fileNames)
If errCheck Then
Exit Sub
End If
'''
For Each Key In fileNames 'loop through the dictionary
On Error Resume Next
Set wb = Workbooks.Open(fileNames(Key))
If Err.Number <> 0 Then
Set wb = Nothing ' or set a boolean error flag
End If
On Error GoTo 0 ' or your custom error handler
If wb Is Nothing Then
Debug.Print "Error when loading " & fileNames(Key)
Else
Debug.Print "Successfully loaded " & fileNames(Key)
wb.Application.Visible = False 'make it not visible
' more working with wb
End If
' Check each sheet in turn
For Each ws In ActiveWorkbook.Worksheets
With ws
' Only action the sheet if it's not the 'Unique data' sheet
If .Name <> wksSummary.Name Then
boolWritten = False
' Find the Scenario column
intColScenario = 0
On Error Resume Next
intColScenario = WorksheetFunction.Match("scenarioName", .Rows(1), 0)
On Error GoTo 0
If intColScenario > 0 Then
' Only action if there is data in column E
If Application.WorksheetFunction.CountA(.Columns(intColScenario)) > 1 Then
' Find the next free column, in which the extract formula will be placed
intColNext = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
' Assign formulas to the next free column to identify the scenario name to the left of the first _ character
.Cells(1, intColNext).Value = "Test"
lr = .Cells(.Rows.Count, intColScenario).End(xlUp).Row
Set myrg = .Range(.Cells(2, intColNext), .Cells(lr, intColNext))
With myrg
.ClearContents
.FormulaR1C1 = "=IFERROR(LEFT(RC" & intColScenario & ",FIND(INDEX({""+"",""-"",""_"",""$"",""%""},1,MATCH(1,--(ISNUMBER(FIND({""+"",""-"",""_"",""$"",""%""},RC" & _
intColScenario & "))),0)), RC" & intColScenario & ")-1), RC" & intColScenario & ")"
.Value = .Value
End With
' Copy unique values from the formula column to the 'Unique data' sheet, and write sheet & file details
.Range(.Cells(1, intColNext), .Cells(lr, intColNext)).AdvancedFilter xlFilterCopy, , r, True
r.Offset(0, -2).Value = ws.Name
r.Offset(0, -3).Value = ws.Parent.Name
' Clear the interim results
.Range(.Cells(1, intColNext), .Cells(lr, intColNext)).ClearContents
' Delete the column header copied to the list
r.Delete Shift:=xlUp
boolWritten = True
End If
End If
' Find the Node column
intColNode = 0
On Error Resume Next
intColNode = WorksheetFunction.Match("node", .Rows(1), 0)
On Error GoTo 0
If intColNode > 0 Then
' Only action if there is data in column A
If Application.WorksheetFunction.CountA(.Columns(intColNode)) > 1 Then
lr = .Cells(.Rows.Count, intColNode).End(xlUp).Row
' Copy unique values from column A to the 'Unique data' sheet, and write sheet & file details (if not already written)
.Range(.Cells(1, intColNode), .Cells(lr, intColNode)).AdvancedFilter xlFilterCopy, , y, True
If Not boolWritten Then
y.Offset(0, -1).Value = ws.Name
y.Offset(0, -2).Value = ws.Parent.Name
End If
' Delete the column header copied to the list
y.Delete Shift:=xlUp
End If
End If
' Identify the next row, based on the most rows used in columns C & D
lngLastNode = wksSummary.Cells(wksSummary.Rows.Count, 3).End(xlUp).Row
lngLastScen = wksSummary.Cells(wksSummary.Rows.Count, 4).End(xlUp).Row
lngNextRow = WorksheetFunction.Max(lngLastNode, lngLastScen) + 1
If (lngNextRow - lngStartRow) > 1 Then
' Fill down the workbook and sheet names
z.Resize(lngNextRow - lngStartRow, 2).FillDown
If (lngNextRow - lngLastNode) > 1 Then
' Fill down the last Node value
wksSummary.Range(wksSummary.Cells(lngLastNode, 3), wksSummary.Cells(lngNextRow - 1, 3)).FillDown
End If
If (lngNextRow - lngLastScen) > 1 Then
' Fill down the last Scenario value
wksSummary.Range(wksSummary.Cells(lngLastScen, 4), wksSummary.Cells(lngNextRow - 1, 4)).FillDown
End If
End If
Set y = wksSummary.Cells(lngNextRow, 3)
Set r = y.Offset(0, 1)
Set z = y.Offset(0, -2)
lngStartRow = y.Row
End If
End With
Next ws
wb.Close savechanges:=False 'close the workbook do not save
Set wb = Nothing 'release the object
Next 'End of the fileNames loop
Set fileNames = Nothing
' Autofit column widths of the report
wksSummary.Range("A1:D1").EntireColumn.AutoFit
' Reset system settings
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.Visible = True
End With
End Sub
答案 0 :(得分:0)
如果你想跳过不可读的文件,你应该摆脱CorruptLoad:=xlRepairFile
(显然它不会对你的文件起作用),并在尝试打开之前直接使用On Error Resume Next
文件。
像这样:
On Error Resume Next
Set wb = Workbooks.Open(fileNames(Key))
If Err.Number <> 0 Then
Set wb = Nothing ' or set a boolean error flag
End If
On Error GoTo 0 ' or your custom error handler
If wb Is Nothing Then
Debug.Print "Error when loading " & fileNames(Key)
Else
Debug.Print "Successfully loaded " & fileNames(Key)
wb.Application.Visible = False 'make it not visible
' more working with wb
' all
' your
' code
' goes
' here :)
End If
修改强>
所有来自
的代码' Check each sheet in turn
For Each ws In ActiveWorkbook.Worksheets
(您应该使用wb
而不是ActiveWorkbook
)
到
wb.Close savechanges:=False 'close the workbook do not save
Set wb = Nothing 'release the object
在我的占位符评论
之后(或者更确切地说代替)属于Else部分' more working with wb
如果已成功加载工作簿,则只应执行此操作。
修改2
关于wb
vs ActiveWorkbook
:
它提高了代码的健壮性,以避免尽可能地使用ActiveWorkbook
,ActiveSheet
等,尤其是在使用多个工作簿时。稍后对代码进行的某些更改可能会在您使用它时激活不同的工作簿,突然您的代码将失败。 (可能在这里没有这个功能,但它是一般的经验法则。)
wb
刚刚分配给已打开的工作簿
Set wb = Workbooks.Open(fileNames(Key))
因此,将wb
变量用于您对该工作簿执行的所有操作是一种很好的做法。
对于跳过的文件:
而不是
Debug.Print "Error when loading " & fileNames(Key)
只需将它们收集在一个字符串
中strErrorFiles = strErrorFiles & vbCrLf & fileNames(Key)
以及后来MsgBox
那个字符串。但请注意MsgBox
对其显示的文本数量有限制,因此如果可能有大量错误文件,最好将它们写入工作表。