How can i count errors inside Excel vba code?-CodePudding

I have this code in Excel VBA to lookup PDF files and I cannot figure out a way to count the number of errors made by the research. Can anyone help me?

Sub Busqueda_MSDS()

Windows("Excel1.xlsm").Activate
Sheets("Sheet 2").Visible = True
 
Dim ws As Worksheet
Dim folder As String
Dim file As String
Dim route As String
Dim format As String
Dim errors As Integer
Dim i As Integer

i = 2
CARPETA = "C:\Users\documents\pdfs\"
FORMATO = ".pdf"


Do While ThisWorkbook.Sheets("Sheet2").Range("G" & i) <> ""
If ThisWorkbook.Sheets("Sheet2").Range("G" & i) > "" Then ActiveWorkbook.FollowHyperlink Folder & ThisWorkbook.Sheets("Sheet2").Range("G" & i) & Format


i = i   1
errores = errores   1

Loop

End Sub

The code itself already works, I just need to count the times when it fails.

CodePudding user response：

Please, use the next adapted code:

Sub Busqueda_MSDS()
 Dim wb As Workbook, ws As Worksheet
 Dim folder As String, FORMATO As String, i As Long, strErr As String, arrErr

 Set wb = ThisWorkbook
 Set ws = wb.Sheets("Sheet2")
 folder = "C:\Users\documents\pdfs\"
 FORMATO = ".pdf"

 i = 2
 Do While ws.Range("G" & i).Value <> ""
    On Error Resume Next
     wb.FollowHyperlink folder & ws.Range("G" & i).Value & FORMATO
     If err.Number <> 0 Then
        err.Clear
        strErr = strErr & ws.Range("G" & i).Value & "|"
     End If
    On Error GoTo 0
   i = i   1
 Loop
 If strErr <> "" Then
    strErr = left(strErr, Len(strErr) - 1) 'eliminate the last "|"
    arrErr = Split(strErr, "|")
    MsgBox UBound(arrErr)   1 & " errors occurs..." & vbCrLf & _
               "The next pdf files could not be open:" & vbCrLf & _
               Join(arrErr, vbCrLf)
 Else
    MsgBox "No eny error appeared..."
 End If
End Sub

It will also return a list of the problematic files name (without "pdf" extension. Not complicated to add it).

Please, test it and send some feedback

CodePudding user response：

Count Missing Files

Option Explicit

Sub CountMissingFiles()
    Const ProcTitle As String = "Count Missing Files"

    Const sFolderPath As String = "C:\Users\documents\pdfs\"
    Const sFileExtension As String = ".pdf"

    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Worksheets("Sheet2")
    Dim dfCell As Range: Set dfCell = dws.Range("G2")
    Dim dlCell As Range: Set dlCell = dws.Cells(dws.Rows.Count, "G").End(xlUp)
    Dim drg As Range: Set drg = dws.Range(dfCell, dlCell)
    'drg.Interior.Color = xlNone
    
    Dim dCell As Range
    Dim sFilePath As String
    Dim MissingCount As Long
    
    For Each dCell In drg.Cells
        sFilePath = sFolderPath & CStr(dCell.Value) & sFileExtension
        If Len(Dir(sFilePath)) = 0 Then
            MissingCount = MissingCount   1
            ' Highlight missing cell
            'dCell.Interior.Color = 14083324
            ' Print not existing filepath to the Immediate window (Ctrl G)
            'Debug.Print "(" & MissingCount & ") " & sFilePath
        End If
    Next dCell
    
    MsgBox "Found '" & MissingCount & " missing files.", _
        vbInformation, ProcTitle
        
End Sub