正在从超链接图像中提取文件 URL

Extracting file URL from a Hyperlinked Image

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 从该图片下载文件。请指教。谢谢

您也许可以使用 POST (action="/pdq/SurveyOutputServlet") 直接点击表单目标,但它需要 元素的 post 字符串连同他们的价值观。大多数(如果不是全部)这些输入元素都已通过转到该页面为您填写。您需要做的就是收集它们并将它们连接成一个 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

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

一旦响应存储在 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 请求(顺便说一句,这是一个很棒的答案)。