如何解决运行时错误“430”等自动化错误在VBA为Excel

Question

我最近为我在 VBA for Excel 工作的公司编写了一些代码。代码的目的是在 Excel 上运行输入的零件编号列表，搜索它们各自的 URL，然后将该网页以 PDF 格式保存到所选文件夹中。

我使用我见过的其他项目的一些灵感和代码编写了这段代码，并且还必须添加一些我自己的代码。

我的问题是这样的：
我放在这里的代码在我的电脑上完美运行。我已经用许多不同的数字对其进行了多次测试，并且每次都按预期工作。话虽如此，我通过电子邮件将其发送给我的顾问供他使用，因为我正在为他制作这个 Excel 项目。

当他在我发送它的那天打开它时，它对他和我一样完美。第二天他尝试运行它并开始出现我从未见过的自动化错误

运行时错误“430”

还有一些其他类似的错误。

有谁知道为什么该程序会在某一天而不是下一天运行和/或是否有解决方案？

我主要是困惑为什么它会突然停止为他工作（它仍然在我的电脑上完美运行）。此外，对于下面的代码，它确实遵循一个真实的链接，为了公司隐私，我只是将网站部分更改为“url”。

尽管如此，我仍然认为这并不重要，因为我相信代码正确地遵循第一个链接，然后在必须循环遍历多个部件号时出现错误。

Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Function DownloadFile(URL As String, LocalFilename As String) As Boolean
    Dim lngRetVal As Long
    lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
    If lngRetVal = 0 Then DownloadFile = True
End Function

Sub DownloadItemPDF()
    Dim strPDFLink As String
    Dim strPDFFile As String
    Dim doc, hcol, text As Variant
    Dim itemNum As Long
    Dim count As Integer
    Dim i As Long
    Dim URL As String
    Dim IE As Object
    Dim objElement As Object
    Dim objCollection As Object

    Set IE = CreateObject("InternetExplorer.Application")         
    IE.Visible = False

    MsgBox "Select Folder to Save .pdf to"
    Dim FolderName As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show

        On Error Resume Next
        strDir = .SelectedItems(1)
        Err.clear
        On Error GoTo 0
    End With

    ActiveSheet.Range("H3").Select

    For count = 1 To 15
        If Not Selection.Value = "" Then        
            itemNum = Selection.Value
            strPDFLink = "url" & itemNum & "url"
            strPDFFile = strDir & "/Drawing2D_" & itemNum & "_" & Format(Now, "yyyy.mm.dd") & ".pdf"
            IE.Navigate strPDFLink
            Do While IE.ReadyState = 4: DoEvents: Loop
            Do Until IE.ReadyState = 4: DoEvents: Loop
            Application.Wait (Now + #12:00:02 AM#)
            Result = DownloadFile(strPDFLink, strPDFFile)
        End If

        Selection.Offset(1, 0).Select
    Next count
End Sub

Answer 1

试试下面的代码。我重新组织了它，使它更稳定。我还包括了一个错误处理，以防止在后台隐藏任何 IE 进程。

Public Sub DownloadItemPDF()
    MsgBox "Select Folder to Save .pdf to"

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show

        On Error Resume Next 'hide all error messages
        Dim strDir As String
        strDir = .SelectedItems(1)
        'check if an error occured and exit sub if something went wrong otherwise yo u end up with an empty strDir 
        If Err.Number <> 0 Then
            MsgBox "No valid folder was picked.", vbCritical
            Exit Sub
        End If
        On Error GoTo 0
    End With

    Dim ws As Worksheet
    Set ws = ThisWorkbook.ActiveSheet 'better define a concrete sheet: ThisWorkbook.Worksheets("SheetName")
                                      'because ActiveSheet might be the wrong one!

    Dim CheckRange As Range
    Set CheckRange = ws.Range("H3").Resize(RowSize:=15)

    Dim IE As Object
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = False

    On Error GoTo QUIT_IE 'if an error occurs make sure the invisible IE gets closed

    Dim Cell As Range
    For Each Cell In CheckRange
        If Not Cell.Value = vbNullString Then
            Dim itemNum As Long
            itemNum = Cell.Value

            Dim strPDFLink As String
            strPDFLink = "url" & itemNum & "url"

            Dim strPDFFile As String
            strPDFFile = strDir & "/Drawing2D_" & itemNum & "_" & Format$(Now, "yyyy.mm.dd") & ".pdf"

            IE.navigate strPDFLink
            Do While IE.readyState <> 4 Or IE.Busy: DoEvents: Loop

            Application.Wait (Now + #12:00:02 AM#)
            Dim Result As Boolean
            Result = DownloadFile(strPDFLink, strPDFFile)
        End If
    Next Cell

QUIT_IE:
    IE.Quit 'don't forget to quit IE in case of error otherwise it will stay open invisible
    Set IE = Nothing
    If Err.Number <> 0 Then
        MsgBox "Error occured while trying to load:" & vbCrLf & strPDFLink & vbCrLf & "To:" & vbCrLf & strPDFFile
        Debug.Print "strPDFLink:", strPDFLink
        Debug.Print "strPDFFile:", strPDFFile
        Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
    End If
End Sub