Excel VBA - 在文件夾中循環文件和使用子過程時錯誤處理

Question

我創建了一個宏來遍歷文件夾中的文件並通過 2 個子過程（其中一個子過程也調用其他子過程）運行一些操作。 在某些情況下，文件沒有正確的格式或導致任何子過程失敗的任何其他錯誤。 我想添加錯誤處理，以便它跳過文件，但它將文件的名稱保存在 txt 或最后的 msg 框中，顯示哪些文件未處理。 我對循環中的錯誤處理不熟悉，所以我不確定如何做到這一點。 任何幫助將非常感激。

Sub PL1BatchFiles()

Dim folderName As String, eApp As Excel.Application, fileName As String
Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook
Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
Set currWb = ActiveWorkbook: Set currWs = ActiveSheet
Dim lcolPS As Integer
Dim lcolTC As Integer
Dim lcolRTD As Integer
Dim NumberPS As Integer
Dim TC_Number As Integer
Dim RTD_Number As Integer
Dim fileName2 As String


'Select folder in which all files are stored
fDialog.Title = "Select a folder"
fDialog.InitialFileName = currWb.Path
If fDialog.Show = -1 Then
  folderName = fDialog.SelectedItems(1)
End If

 'Create a separate Excel process that is invisibile
Set eApp = New Excel.Application:  eApp.Visible = True
eApp.DisplayAlerts = False
eApp.ScreenUpdating = False

'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]
fileName = Dir(folderName & "\*Steady*.xlsx")
'fileName = "C:\Users\mconejoh\OneDrive - Intel Corporation\Documents\Lidded BGA\ETB4_noTS_lid_5W_CPU_heavy.xlsx"
Do While fileName <> ""
    'Update status bar to indicate progress
    Application.StatusBar = "Processing " & folderName & "\" & fileName
    Set wb = eApp.Workbooks.Open(folderName & "\" & fileName)
    eApp.DisplayAlerts = False
    eApp.ScreenUpdating = False
    
    'Get the PS, RTD and TC number:
    lcolPS = wb.Worksheets("Power").Cells(1, Columns.Count).End(xlToLeft).Column
    NumberPS = (lcolPS - 1) / 3
    lcolTC = wb.Worksheets("Thermocouples").Cells(1, Columns.Count).End(xlToLeft).Column
    TC_Number = lcolTC - 1
    lcolRTD = wb.Worksheets("RTDS").Cells(1, Columns.Count).End(xlToLeft).Column
    RTD_Number = lcolRTD - 1
    
    'Run each subprocedure

    Call RTS_powerSheet(wb, NumberPS)
    Call PL1_only(wb, RTD_Number, TC_Number, NumberPS)
    wb.Close SaveChanges:=True
    'Close opened worbook w saving, change as needed
    fileName = Dir()
    
    eApp.DisplayAlerts = True
    eApp.ScreenUpdating = True

Loop
eApp.Quit
Set eApp = Nothing
'Clear statusbar and notify of macro completion
Application.StatusBar = ""
MsgBox "Completed executing macro on all workbooks"

結束子

Answer 1

您將您的潛艇重寫為函數。 然后一個結構如何收集潛艇失敗的所有文件可能看起來像這樣

    Sub fileLoop()
    
        Dim Foldername, fileName
        
        Dim colProblem As New Collection
     
        fileName = Dir(Foldername & "\*Steady*.xlsx")
        Do While fileName <> ""
    
            If Not Dosth(fileName) Then
                colProblem.Add fileName
            End If
    
            fileName = Dir()
    
        Loop
    
    End Sub
    
    Function Dosth(fileName) As Boolean
    
        On Error GoTo EH
        ' ... Code here
        
        ' In case everything went fine
        ' function did its job
        Dosth = True
        
        Exit Function

     EH:

        Dosth = false

    End Function