我如何计数Excel VBA代码中的错误?

Question

我在Excel VBA中有这个代码来查找PDF文件，我无法想出一种方法来计算研究所产生的错误数量。有人能帮我吗?

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:Usersdocumentspdfs"
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

代码本身已经工作了，我只需要计算失败的次数。

Answer 1

请使用下一个改编代码:

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:Usersdocumentspdfs"
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

它还将返回有问题文件名的列表(不带"pdf")扩展。这并不复杂)。

请测试它并发送一些反馈

Answer 2

统计丢失文件

Option Explicit
Sub CountMissingFiles()
Const ProcTitle As String = "Count Missing Files"
Const sFolderPath As String = "C:Usersdocumentspdfs"
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