Question

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下载数据，并发现此代码运行良好。我尝试下载数据的网页网址是我在代码中使用的网址。请花一点时间打开网页，因为我试图下载的Excel文件已链接到图像中，因此我无法找到从该图像下载文件的URL。请指教。谢谢。

Answer 1

您可以使用POST（action =“/ pdq / SurveyOutputServlet”）直接命中表单目标，但它期待＆lt; input＆gt;的后置字符串。元素和它们的价值观。大多数（如果不是所有）这些输入元素都是通过转到该页面为您填写的。您需要做的就是收集并将它们连接成一个帖子字符串，然后将其推回到表单中。

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

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

Answer 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请求（这是一个很棒的答案）。

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

2 个答案: