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

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是我在代码中使用的url。 请花点时间打开网页，因为我想下载的Excel文件是链接在图像中，所以我无法find从该图像下载文件的URL。 请指教。 谢谢。

Answer 1

您可以直接使用POST（action =“/ pdq / SurveyOutputServlet”）命中表单目标，但是需要将<input>元素的后置string连同其值。 大部分（如果不是全部）这些input元素已经为您填写，只需转到该页面即可。 所有你需要做的是收集和连接成一个后置string被推回到窗体。

 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 

这是非常简约的，但它是所有你需要的。 至less有一个非标准的input元素没有名字，但我select将其值返回。 我没有按顺序将东西取出，直到它坏了。 我只是build立了POSTstring给予我检索并发回。

_{LNS1400000020150916.xlsx}

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