2016-11-20 9 views
0

このコードを実行するために複数の計測器番号とURLを使用します。計器番号は、列Bの行8から下に開始されます。このVBAは現在、機器番号19930074944のみを実行しています。どのようにこれらのすべての機器番号をループし、空のセルをスキップすることができますか?複数のURLと実行中のHTMLリクエストを使用したVBAループ

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=" 

InstNumB8とダウンを参照する必要があります。また、このコードをそれぞれ異なる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 

答えて

0

何か:

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 

編集パラメータを含めるためにあなたの元のコードyou..Loopingのために働く必要があり

Public Sub Download_PDF(InsNumber) 
'.... 
'.... 
searchResultsURL = baseURL & "GetRecDataDetail.aspx?rec=" & InsNumber & _ 
     "&suf=&bdt=1/1/1947&edt=11/18/2016&nm=&doc1=&doc2=&doc3=&doc4=&doc5=" 

'.... 
'.... 
End Sub 
+0

こんにちはHA560、私は、要求されたヘッドが2番目の反復でエラーが見つかりませんでした。cookie = .getResponseHeader( "Set-Cookie")ありがとう。 –

+0

あなたは私が考えて間違った答えに答えました –

+0

ティム、それは働いた。大変ありがとうございました。 HAにもありがとうございました! –

0

こんにちはザ・コードの下に(関連する部分のみを示します)すべての要素を介して.. 注:シート1を必要なシートに変更します。答えとして記入してください。

 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 
関連する問題