时间戳

首页 > 解决方案 > 循环文件夹中的文件并使用子过程时的错误处理

vba - 循环文件夹中的文件并使用子过程时的错误处理

问题描述

我遍历文件夹中的文件并通过两个子过程（其中一个子过程调用其他子过程）运行一些操作。

在某些情况下，文件没有正确的格式或错误导致任何子过程失败。

我想添加错误处理，以便它跳过文件，但将文件名保存在 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"
    
End Sub

标签： vbaloopserror-handling

解决方案

您将您的潜艇重写为函数。然后一个结构如何收集潜艇失败的所有文件可能看起来像这样

    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

推荐阅读