Извлечение URL-адреса файла из гиперссылки

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 и нашел, что этот код работает довольно хорошо. URL-адрес веб-страницы, с которого я пытаюсь загрузить данные, является тем, который я использовал в коде. Пожалуйста, найдите минутку и откройте веб-страницу, поскольку файл Excel, который я пытаюсь загрузить, связан с изображением, поэтому я не могу найти URL-адрес для загрузки файла с этого изображения. Пожалуйста посоветуй. Благодарю.

Answer 1

Вы можете быть в состоянии поразить цель формы непосредственно с POST (действием = «/ PDQ/SurveyOutputServlet»), но он ожидает после строки из < ввода > элементов вместе с их значениями. Большинство, если не все эти элементы ввода были заполнены для вас, просто перейдя на эту страницу. Все, что вам нужно сделать, это собрать и объединить их в строку сообщения, которую нужно отбросить в форму.

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}

Вы, вероятно, будет двигаться этот код в какой-то цикл. Соответственно отрегулируйте имя получателя. Каждая новая страница должна соответствующим образом настраивать собственные элементы ввода формы.