Question

我将拥有多个工具编号和网址来运行此代码。仪器编号将从行B的列8开始向下。此VBA目前仅运行工具编号19930074944。如何让它遍历所有这些仪器编号并跳过空白单元格？

searchResultsURL = baseURL & "GetRecDataDetail.aspx?rec=19930074944&suf=&bdt=1/1/1947&edt=11/18/2016&nm=&doc1=&doc2=&doc3=&doc4=&doc5="

所以我需要编辑它以便它：

searchResultsURL = baseURL & "GetRecDataDetail.aspx?rec= & InstNum & "&suf=&bdt=1/1/1947&edt=11/18/2016&nm=&doc1=&doc2=&doc3=&doc4=&doc5="

然后InstNum必须引用B8并向下引用。并在每个不同的URL上运行所有这些代码。我不知道该怎么做。非常感谢！

Option Explicit

Public Sub Download_PDF()

Dim baseURL As String, searchResultsURL As String, pdfURL As String,    PDFdownloadURL As String
Dim httpReq As Object
Dim HTMLdoc As Object
Dim PDFlink As Object
Dim cookie As String
Dim downloadFolder As String, localFile As String

Const WinHttpRequestOption_EnableRedirects = 6

'Folder in which the downloaded file will be saved

downloadFolder = ThisWorkbook.Path
If Right(downloadFolder, 1) <> "\" Then downloadFolder = downloadFolder & "\"

baseURL = "http://recorder.maricopa.gov/recdocdata/"
searchResultsURL = baseURL & "GetRecDataDetail.aspx?       rec=19930074944&suf=&bdt=1/1/1947&edt=11/18/2016&nm=&doc1=&doc2=&doc3=&doc4=&doc5="

Set httpReq = CreateObject("WinHttp.WinHttpRequest.5.1")

With httpReq

'Send GET to request search results page

.Open "GET", searchResultsURL, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:46.0) Gecko/20100101 Firefox/46.0"
.Send
cookie = .getResponseHeader("Set-Cookie")

'Put response in HTMLDocument for parsing
Set HTMLdoc = CreateObject("HTMLfile")
HTMLdoc.body.innerHTML = .responseText

'Get PDF URL from pages link
'< a id="ctl00_ContentPlaceHolder1_lnkPages" title="Click to view unofficial   document"
' href="unofficialpdfdocs.aspx?rec=19930074944&pg=1&cls=RecorderDocuments&suf="  target="_blank">11< /a>

Set PDFlink = HTMLdoc.getElementById("ctl00_ContentPlaceHolder1_lnkPages")
pdfURL = Replace(PDFlink.href, "about:", baseURL)
'Send GET request to the PDF URL with automatic http redirects disabled.         This returns a http 302 status (Found) with the Location header containing the URL of the PDF file

.Open "GET", pdfURL, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:46.0)  Gecko/20100101 Firefox/46.0"
.setRequestHeader "Referer", searchResultsURL
.setRequestHeader "Set-Cookie", cookie
.Option(WinHttpRequestOption_EnableRedirects) = False
.Send
PDFdownloadURL = .getResponseHeader("Location")

'Send GET to request the PDF file download

.Open "GET", PDFdownloadURL, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:47.0) Gecko/20100101 Firefox/46.0"
.setRequestHeader "Referer", pdfURL
.Send

End With
End Sub

Answer 1

这样的事情：

check_participants(t, ...)

编辑原始代码以包含参数（仅显示相关部分）

Sub DoAll()
    Dim c As Range
    Set c = Activesheet.Range("B8")
    Do While c.Value<>""

        Download_PDF c.Value

        Set c = c.offset(1,0) 'next value
    Loop
End sub

Answer 2

您好以下代码应该适合您。通过所有元素... 注意：将sheet1更改为所需的sheet.Pls标记为答案。

        Option Explicit

        Public Sub Download_PDF()

        Dim baseURL As String, searchResultsURL As String, pdfURL As String, PDFdownloadURL As String
        Dim httpReq As Object
        Dim HTMLdoc As Object
        Dim PDFlink As Object
        Dim cookie As String
        Dim downloadFolder As String, localFile As String

        Const WinHttpRequestOption_EnableRedirects = 6

        'Folder in which the downloaded file will be saved

        downloadFolder = ThisWorkbook.Path
        If Right(downloadFolder, 1) <> "\" Then downloadFolder = downloadFolder & "\"

        baseURL = "http://recorder.maricopa.gov/recdocdata/"


        Set httpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
        Dim Instnum As String
        Dim i As Integer
        For i = 8 To Sheet1.Range("b" & Rows.Count).End(xlUp).Row

        Instnum = Sheet1.Cells(i, 2).Value
        searchResultsURL = baseURL & "GetRecDataDetail.aspx?       rec=" & Instnum & "&suf=&bdt=1/1/1947&edt=11/18/2016&nm=&doc1=&doc2=&doc3=&doc4=&doc5="
        With httpReq

        'Send GET to request search results page

        .Open "GET", searchResultsURL, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:46.0) Gecko/20100101 Firefox/46.0"
        .Send
        cookie = .getResponseHeader("Set-Cookie")

        'Put response in HTMLDocument for parsing
        Set HTMLdoc = CreateObject("HTMLfile")
        HTMLdoc.body.innerHTML = .responseText

        'Get PDF URL from pages link
        '< a id="ctl00_ContentPlaceHolder1_lnkPages" title="Click to view unofficial   document"
        ' href="unofficialpdfdocs.aspx?rec=19930074944&pg=1&cls=RecorderDocuments&suf="  target="_blank">11< /a>

        Set PDFlink = HTMLdoc.getElementById("ctl00_ContentPlaceHolder1_lnkPages")
        pdfURL = Replace(PDFlink.href, "about:", baseURL)
        'Send GET request to the PDF URL with automatic http redirects disabled.         This returns a http 302 status (Found) with the Location header containing the URL of the PDF file

        .Open "GET", pdfURL, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:46.0)  Gecko/20100101 Firefox/46.0"
        .setRequestHeader "Referer", searchResultsURL
        .setRequestHeader "Set-Cookie", cookie
        .Option(WinHttpRequestOption_EnableRedirects) = False
        .Send
        PDFdownloadURL = .getResponseHeader("Location")

        'Send GET to request the PDF file download

        .Open "GET", PDFdownloadURL, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; rv:47.0) Gecko/20100101 Firefox/46.0"
        .setRequestHeader "Referer", pdfURL
        .Send

        End With
        Next i
        End Sub

VBA通过多个URL循环并运行HTML请求

2 个答案: