Нужен Excel VBA для навигации по сайту и загрузки определенных файлов - PullRequest
1 голос
/ 12 июня 2019

Попытка понять, как взаимодействовать с сайтом определенным образом.Это часть более крупного кода, над которым я работаю, который будет перебирать список ContractorID.Отсюда мне нужно сделать следующее:

  1. Перейдите на этот сайт: https://ufr.osd.state.ma.us/WebAccess/SearchDetails.asp?ContractorID=042786217&FilingYear=2018&nOrgPage=7&Year=2018

  2. Найдите ссылку с надписью «Подшивка UFR с проверкой»Финансовые "и нажмите на него.(если его там нет, завершите подпункт)

  3. На следующей странице найдите ссылку, которая указана в разделе «Категория документа» как «Шаблон Excel UFR», и нажмите на нее.(в этом случае ссылка говорит «15-UFR18.xls», однако, поскольку отсутствует согласованная схема именования ссылок, правильная ссылка всегда должна указываться меткой в ​​разделе «Категория документа», как упомянуто. Если ссылка не 't существует, выйдите из подпункта.)

  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

1 Ответ

1 голос
/ 13 июня 2019

Я пробовал шаг 3 с каким-то длинным способом. но не может предоставить полный код загрузки, поскольку (после одной успешной попытки ручного запуска) в настоящее время даже попытка загрузки вручную вызывает массаж «Файл не может быть получен» (возможно, ограничение на стороне сервера)

Код только приведет вас к ячейке, содержащей href файла xlx

 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 и других.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...