需要 Excel VBA 来浏览网站和下载特定文件

Question

试图了解如何以特定方式与网站互动。这是我正在处理的更大代码的一部分，它将遍历 ContractorID 列表。我需要从这里做的是：

1. 导航至此网站：https://ufr.osd.state.ma.us/WebAccess/SearchDetails.asp?ContractorID=042786217&FilingYear=2018&nOrgPage=7&Year=2018

2. 找到“UFR Filing with Audited Financials”链接并单击它。 （如果不存在，结束子）

3. 在随后的页面上，找到在“文档类别”下标识为“UFR Excel 模板”的链接并单击它。 （在这种情况下，链接显示“15-UFR18.xls”，但是由于没有一致的链接命名方案，正确的链接将始终必须由“文档类别”下的标签标识。如果链接没有t 存在，退出 sub。）

4. 在随后的页面上，单击顶部的“下载”链接，并将文件保存在以下文件路径下（此时将创建）：C:\Documents\042786217\2018。

编辑：下面的代码让我到达点击下载按钮的位置，然后我得到打开/保存/取消对话框。差不多了，只需要弄清楚如何将文件保存到特定路径即可。

Option Explicit
Sub UFRScraper()

    If MsgBox("UFR Scraper will run now. Do you wish to continue?", vbYesNo) = vbNo Then Exit Sub

    Dim IE As Object
    Dim objElement As Object
    Dim objCollection As Object
    Dim ele As Object
    Dim tbl_Providers As ListObject: Set tbl_Providers = ThisWorkbook.Worksheets("tbl_ProviderList").ListObjects("tbl_Providers")
    Dim FEIN As String: FEIN = ""
    Dim FEINList As Range: Set FEINList = tbl_Providers.ListColumns("FEIN").DataBodyRange
    Dim ProviderName As String: ProviderName = ""
    Dim ProviderNames As Range: Set ProviderNames = tbl_Providers.ListColumns("Provider Name").DataBodyRange
    Dim FiscalYear As String: FiscalYear = ""
    Dim urlUFRDetails As String: urlUFRDetails = ""
    Dim i As Integer

    ' Create InternetExplorer Object
    Set IE = CreateObject("InternetExplorer.Application")

    ' Show (True)/Hide (False) IE
    IE.Visible = True

    i = 1
    For i = 1 To 3 'Limited to 3 during testing. Change when ready.
        FEIN = FEINList(i, 1)
        ProviderName = ProviderNames(i, 1)

        urlUFRDetails = "https://ufr.osd.state.ma.us/WebAccess/SearchDetails.asp?ContractorID=" & FEIN & "&FilingYear=2018&nOrgPage=1&Year=2018"

        IE.Navigate urlUFRDetails

        ' Wait while IE loading...
        'IE ReadyState = 4 signifies the webpage has loaded (the first loop is set to avoid inadvertently skipping over the second loop)
        Do While IE.ReadyState = 4: DoEvents: Loop   'Do While
        Do Until IE.ReadyState = 4: DoEvents: Loop   'Do Until


        'Step 2 is done here
        Dim filingFound As Boolean: filingFound = False
        For Each ele In IE.Document.getElementsByTagName("a")
            If ele.innerText = "UFR Filing with Audited Financials" Then
                filingFound = True
                IE.Navigate ele.href
                Do While IE.ReadyState = 4: DoEvents: Loop   'Do While
                Do Until IE.ReadyState = 4: DoEvents: Loop   'Do Until
                Exit For
            End If
        Next ele

        If filingFound = False Then
            GoTo Skip
        End If


        'Step 3
        Dim j As Integer: j = 0
        Dim UFRFileFound As Boolean: UFRFileFound = False
        For Each ele In IE.Document.getElementsByTagName("li")
            j = j + 1
            If ele.innerText = "UFR Excel Template" Then
                UFRFileFound = True
                IE.Navigate "https://ufr.osd.state.ma.us/WebAccess/documentviewact.asp?counter=" & j - 4
                Do While IE.ReadyState = 4: DoEvents: Loop   'Do While
                Do Until IE.ReadyState = 4: DoEvents: Loop   'Do Until
                Exit For
            End If
        Next ele

        If UFRFileFound = False Then
            GoTo Skip
        End If


        'Step 4
        IE.Document.getElementById("LinkButton2").Click

        '**Built in wait time to avoid accidentally overloading server with repeated quick requests during development and testing**
Skip:
        Application.Wait (Now + TimeValue("0:00:03"))
        MsgBox "Loop " & i & " complete."

    Next i

    'Unload IE
    IE.Quit
    Set IE = Nothing
    Set objElement = Nothing
    Set objCollection = Nothing

    MsgBox "Process complete!"

End Sub

Answer 1

我已经尝试了第 3 步，但方法很冗长。但目前无法提供完整的下载代码（在一次成功的手动尝试后），即使手动下载尝试导致消息“无法检索文件”（可能是服务器端约束）

代码仅将您带到 xlx 文件中包含 href 的单元格

 Dim doc As HTMLDocument
        Dim Tbl As HTMLTable, Cel As HTMLTableCell, Rw As HTMLTableRow, Col As HTMLTableCol
        Set doc = IE.document

        For Each ele In IE.document.getElementsByClassName("boxedContent")
            For Each Tbl In ele.getElementsByTagName("table")
               For Each Rw In Tbl.Rows
                    For Each Cel In Rw.Cells
                    'Debug.Print Cel.innerText
                        If InStr(1, Cel.innerText, "UFR Excel Template") > 0 Then
                        Debug.Print Rw.Cells(2).innerText & " - " & Rw.Cells(2).innerHTML
                        End If
                    Next
               Next Rw
            Next Tbl
        Next

一旦href 可用PtrSafe 函数或WinHTTPrequest 或其他方法可用于下载文件。欢迎并渴望从@QHarr 等专家那里了解这种情况下的一些更有效的答案。