从超链接图像中提取文件 URL答案

【问题标题】：Extracting file URL from a Hyperlinked Image从超链接图像中提取文件 URL
【发布时间】：2015-09-16 19:33:02
【问题描述】：

Sub DownloadFile() 

    Dim myURL As String
    myURL = "http://data.bls.gov/timeseries/LNS14000000"
    Dim WinHttpReq As Object
    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    WinHttpReq.Open "GET", myURL, False, "username", "password"
    WinHttpReq.send

    myURL = WinHttpReq.responseBody
    If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.responseBody
        oStream.SaveToFile "C:\Downloads\abc.xlsx", 2
        oStream.Close
    End If

End Sub

我正在尝试使用 VBA 下载数据，发现此代码运行良好。我试图从中下载数据的网页 URL 是我在代码中使用的那个。请花点时间打开网页，因为我尝试下载的 Excel 文件链接在图像中，因此我无法找到从该图像下载文件的 URL。请指教。谢谢

【问题讨论】：

IMO 您应该使用 POST 请求，而不是 GET 在您的情况下。打开页面，例如在 Chrome 开发人员工具中（按 F12），在 Elements 选项卡上，找到表单 excel，删除 target="_blank" 并单击文件图标，下载文件后，转到 Network 选项卡，您会看到出现 @987654329 @POST 请求。考虑example of retrieving csv data via XHR。
@omegastripes 我尝试将 URL 输入为“data.bls.gov/pdq/SurveyOutputServlet”并按照您的建议使用 POST，但随后我收到错误消息，指出文件扩展名无效，并且我将网页内容输入excel表而不是数据。如果可以的话，请发表评论。感谢您的帮助。
看看my screenshot，有一堆典型的 POST XHR 表单数据参数。我将其中一些与页面选项链接起来只是为了展示它们的共同目的。因此，您必须通过请求发送所有这些参数。按查看源代码 (output_type=default&years_option=specific_years&from_year=2005&...)，您将了解如何创建要发送的字符串。通过上面的链接查看我的示例。

标签： vba excel web-scraping automation

【解决方案1】：

您可能可以直接使用 POST (action="/pdq/SurveyOutputServlet") 命中表单目标，但它需要元素及其值的 post 字符串。只需转到该页面即可为您填写大多数（如果不是全部）这些输入元素。您需要做的就是收集它们并将它们连接成一个帖子字符串，然后将它们推回到表单中。

Option Explicit

'base web page
Public Const csBLSGOVpg = "http://data.bls.gov/timeseries/LNS14000000"
'form's action target
Public Const csXLSDLpg = "http://data.bls.gov/pdq/SurveyOutputServlet"

Sub mcr_Stream_Buyer_Documents()
    Dim xmlDL As New MSXML2.ServerXMLHTTP60, xmlBDY As New HTMLDocument, adoFILE As Object
    Dim xmlSend As String, strFN As String, f As Long, i As Long

    With xmlDL
        .SetTimeouts 5000, 5000, 15000, 25000

        'start by going to the base web page
        .Open "GET", csBLSGOVpg, False
        .setRequestHeader "Content-Type", "text/javascript"
        .send

        If .Status <> "200" Then GoTo bm_Exit

        'get the source HTML for examination; zero the post string var
        xmlBDY.body.innerHTML = .responseText
        xmlSend = vbNullString

        'loop through the forms until you find the right one
        'then loop through the input elements and construct a post string
        For f = 0 To xmlBDY.getElementsByTagName("form").Length - 1
            If xmlBDY.getElementsByTagName("form")(f).Name = "excel" Then
                With xmlBDY.getElementsByTagName("form")(f)
                    For i = 0 To .getElementsByTagName("input").Length - 1
                        xmlSend = xmlSend & Chr(38) & _
                                 .getElementsByTagName("input")(i).Name & Chr(61) & _
                                 .getElementsByTagName("input")(i).Value
                    Next i
                    xmlSend = "?.x=5&.y=5" & xmlSend
                End With
                Exit For
            End If
        Next f
        'Debug.Print xmlSend   'check the POST string

        'send the POST string back to the form's action target
        .Open "POST", csXLSDLpg, False
        xmlDL.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        xmlDL.send xmlSend

        If xmlDL.Status <> "200" Then GoTo bm_Exit

        'pick up the response as a stream and save it as a .XLSX
        strFN = Environ("USERPROFILE") & "\Documents\LNS14000000" & Format(Date, "yyyymmdd") & ".xlsx"
        On Error Resume Next
        Kill strFN
        On Error GoTo 0
        Set adoFILE = CreateObject("ADODB.Stream")
        adoFILE.Type = 1
        adoFILE.Open
        adoFILE.Write .responseBody
        adoFILE.SaveToFile strFN, 2
        Set adoFILE = Nothing

    End With
    Set xmlBDY = Nothing
    Set xmlDL = Nothing
    Exit Sub
bm_Exit:
    Debug.Print Err.Number & ":" & Err.Description
End Sub

这是非常简约的，但它就是你所需要的。至少有一个非标准输入元素没有名称，但我还是选择将其值发回。我没有按顺序移除东西，直到它坏了；我只是根据我检索到的内容构建了 POST 字符串并将其发回。

_{LNS1400000020150916.xlsx}

您可能会将此代码移动到某种循环中。相应地调整接收文件名。每个新页面都应该相应地调整自己的表单输入元素。

【讨论】：

顺便说一句，除了 Microsoft ActiveX Data Objects 2.1 LibraryMicrosoft XML, v6.0 和 Microsoft HTML Object Library /b> 用于该代码。
感谢您的回复和代码帮助。突然间，我发现代码在“.send”行上抛出了“操作超时错误”。你能澄清一下吗？我已经包含了所需的参考资料。谢谢。
代码仍在从我端检索 xlsx 下载。也许你的 IP 被屏蔽了？
是的，它可能与 IP 相关，因为它在我的个人计算机上运行。谢谢。

【解决方案2】：

一旦响应存储在 HTMLDocument 对象中，您就可以使用

的 CSS 选择器

#download_xlsx

"#" 表示 id。

然后你可以点击这个元素

htmlDocument.querySelector("#download_xlsx").Click

VBA：

Option Explicit
Public Sub DownloadFile()
    Dim ie As New InternetExplorer
    With ie
        .Visible = True
        .navigate "https://data.bls.gov/timeseries/LNS14000000"
        While .Busy Or .readyState < 4: DoEvents: Wend
        .document.querySelector("#download_xlsx").Click
        .Quit
    End With
End Sub

其他：

您甚至可以定位表单并提交：

.document.forms("excel").submit

这会触发另一个答案中提到的POST 请求（顺便说一句，这是一个很棒的答案）。

【讨论】：