Excel VBA宏自动填报FAA网页时循环仅处理首条数据即停止的问题

问题背景 #

我使用Excel宏实现FAA（美国联邦航空管理局）通知标准申报流程自动化，核心操作逻辑为：在指定网页填报信息、点击提交按钮、将结果页面打印导出为PDF文件。
从Excel运行主模块时，程序会通过Internet Explorer打开FAA官方申报页面填写表单，将判定结果、运行时间回写至Excel表格，并将结果页以PDF格式保存到选定文件夹。目前第一条结构数据可顺利完成全流程处理，但首次PDF下载完成后循环就会终止，无法继续处理后续行的数据。
主模块代码如下：

Sub Main()
Dim IE As Object
Dim website As String
Dim PDFPath As String, PDFfolder As String, PDFName As String
Dim i As Long
Dim curprinter As String
Dim outdatetime As Date
Dim structure As String
Dim GE As Double, SH As Double
'*** clear Hyper Links ****
Sheets("Main").Range("L2:N100000").ClearContents

'**** request to print to PDF Files ****'
If Cells(13, "Q") = True Then

    'Set the default printer to Adobe PDF (for Adobe Professional).
    'SetDefaultPrinter "Adobe PDF"
    
    If Left(Application.ActivePrinter, 9) <> "Adobe PDF" Then
        MsgBox "Please set Adobe PDF as default printer! exit now. The name of the active printer is " & Application.ActivePrinter
        Exit Sub
    End If
    
    'Check if the PDF's folder exists.
    If Sheets("Main").Range("Q11").Value = "" Then
        MsgBox "Please select a folder to save PDF by click on the [Select PDF Folder] button or enter path to Cell: Q11. Exit Now."
        Exit Sub
    ElseIf FolderExists(Sheets("Main").Range("Q11").Value) = False Then
        MsgBox "The folder: " & Sheets("Main").Range("Q11").Value & " is not valid. Exit now."
        Exit Sub
    End If

    PDFfolder = Sheets("Main").Range("Q11").Value
    If Right(PDFfolder, 1) <> "\" Then PDFfolder = PDFfolder & "\" 'Add the backslash if not exists.
End If
 
website = "https://oeaaa.faa.gov/oeaaa/external/gisTools/gisAction.jsp?action=showNoNoticeRequiredToolForm"

Set IE = CreateObject("InternetExplorer.Application")
i = 2

Do While Cells(i, "D") <> ""

    IE.Navigate website

    While IE.busy
        DoEvents  'wait until IE is done loading page.
    Wend
    
    While IE.ReadyState <> 4
        DoEvents
    Wend
    
    IE.Visible = True
    TxtHtml = IE.Document.getElementById("latDir").innerhtml

    IE.Document.getElementById("latD").Value = Cells(i, "D")
    IE.Document.getElementById("latM").Value = Cells(i, "E")
    IE.Document.getElementById("latS").Value = Round(Cells(i, "F"), 2)
    
    IE.Document.getElementById("longD").Value = Cells(i, "G")
    IE.Document.getElementById("longM").Value = Cells(i, "H")
    IE.Document.getElementById("longS").Value = Round(Cells(i, "I"), 2)
    
    If Int(Cells(i, "J")) = Cells(i, "J") Then
        IE.Document.getElementById("siteElevation").Value = Cells(i, "J")
    Else
        IE.Document.getElementById("siteElevation").Value = Int(Cells(i, "J")) + 1
    End If
    
    If Int(Cells(i, "K")) = Cells(i, "K") Then
        IE.Document.getElementById("unadjustedAgl").Value = Cells(i, "K")
         IE.Document.getElementById("structureHeight").Value = Cells(i, "K")
    Else
        IE.Document.getElementById("unadjustedAgl").Value = Int(Cells(i, "K")) + 1
        IE.Document.getElementById("structureHeight").Value = Int(Cells(i, "K")) + 1
    End If
    
    IE.Document.getElementById("latDir").Value = "N"
    IE.Document.getElementById("longDir").Value = "W"
    
    '**********Change the 2-letter value below to modify the "Traverseway" input on the Notice Criteria Tool Website*************************
    IE.Document.getElementById("traverseway").Value = "NO"
    'Options: "NO"-No Traverseway, "IH"-Interstate Highway, "OT"-Other Traverseway, "PR"-Private Road, "PH"-Public Roadway, "RR"-Railroad, "WW"-Waterway
    '****************************************************************************************************************************************
    
    IE.Document.getElementById("traverseway").FireEvent ("onchange")
    
    Set x = IE.Document.GetElementsByName("submit")
    x(0).Click
    
    '***********CODE-ORIGINAL - ************'
    'IE.Document.getelementbyid("submit").Click
    
    Do While IE.busy Or IE.ReadyState <> 4
        DoEvents
    Loop

    a = IE.Document.body.innerhtml
    aa = InStr(1, a, "Results")
    If aa > 0 Then
        newstring = Mid(a, aa + 7, 250)
        If InStr(newstring, "You do not exceed Notice Criteria.") > 0 Then
            file = "False"
        Else
            With CreateObject("htmlfile")
                .Open
                .write newstring
                .Close
                file = .body.outerText
            End With
        End If
    End If

    Cells(i, "M") = file
    outdatetime = Format(Now, "MM/dd/yyyy  h:mm:ss")
    Cells(i, "N") = Format(outdatetime, "MM/dd/yyyy  h:mm:ss")
    
    If Cells(13, "Q") = True And Left(Application.ActivePrinter, 9) = "Adobe PDF" Then
    
        '**** PDF file name & path ****'
        PDFName = "Structure " & removeSpecial(Sheets("Main").Range("C" & i).Value) & " " & Format(outdatetime, "YYYYMMDD") & ".PDF"
        PDFPath = PDFfolder & PDFName
        '**** Delete the PDF if it already exists  ****'
        If Dir(PDFPath) = PDFName Then Kill (PDFPath)

        '*** structure number to add to PDF file ***'
        structure = "Structure # " & Cells(i, "C")
        
TryAgain:
        'Wait for 2 seconds to let IE load the document
        fTime = Timer
        Do While fTime > Timer - 2
          DoEvents
        Loop
        
        eQuery = IE.QueryStatusWB(6)
        If eQuery And 2 Then
        
            IE.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER
            Call PDFPrint(PDFPath, structure)
           
            fTime = Timer
            Do While fTime > Timer - 2
                DoEvents
                Loop
         Else
           GoTo TryAgain
         End If

        '*** create HyperLink to each PDF File ***'
        With Sheets("Main")
            .Hyperlinks.Add Anchor:=.Range("L" & i), Address:=PDFPath, TextToDisplay:="Link to PDF"
        End With
 
    End If

i = i + 1
Loop

Set IE = Nothing

Call UnWrapM

MsgBox "Done!"

End Sub

问题根因 #

• 打印异步任务冲突：调用IE.ExecWB触发打印、PDFPrint处理Adobe PDF输出是异步操作，现有逻辑只固定等待2秒就进入下一轮循环执行页面跳转。此时打印任务可能还没完全结束，Adobe PDF驱动的端口、生成的PDF文件都处于占用状态，要么导致IE被阻塞抛出静默错误，要么触发文件占用报错，因为全程没有错误捕获，程序直接终止跳出循环。
• 页面就绪判断逻辑漏洞：现有逻辑仅通过IE.busy和IE.ReadyState=4判断页面加载完成，但FAA页面提交后有JS动态渲染内容的过程，这两个状态返回就绪时，页面DOM元素可能还没加载完成，第一轮因为前置等待时间足够没触发问题，第二轮跳转时受打印残留任务影响，DOM获取失败直接报错终止。
• 重试逻辑无超时机制：TryAgain标签的重试逻辑没有设置超时上限，如果打印状态查询一直返回不可用，程序会卡在无限重试的死循环中，表现为流程卡住、无法进入下一条数据处理。
• 无运行时错误捕获：整个流程没有加错误处理逻辑，任意一步出现异常（比如找不到页面元素、打印接口调用失败、文件被占用），程序都会直接终止，不会继续处理后续行，也不会留存错误信息方便排查。

排查修复思路 #

1. 先加全局错误捕获：在循环内部开头增加错误处理逻辑，单条数据处理报错时，把错误信息写到对应行的备注列，主动跳过当前行、i递增后继续处理下一条，不会因为单条数据失败导致整个流程终止。
2. 补全PDF生成完成校验：调用打印后不要只等固定2秒，循环检测目标路径的PDF文件是否存在、且可以正常打开写入（确认打印进程已经释放文件锁），等文件完全生成后再执行后续操作。
3. 优化页面加载判断：除了判断IE的内置就绪状态，增加核心表单元素（比如latD输入框）的存在性校验，确认元素可正常访问后再开始填表单，避免DOM未加载完成就操作元素报错。
4. 给重试逻辑加超时限制：TryAgain重试最多设置10次（总等待时长20秒左右），超时后记录打印失败的错误，跳过当前行继续处理，避免无限死循环。
5. 打印完成后可以显式清空IE的临时缓存，避免上一页的残留资源影响下一轮页面加载。

内容的提问来源于stack exchange，提问作者ZzAtAm