VBA скачать файлы Excel с веб-сайта, где имя файла меняется

Question

Спасибо за вашу помощь. Я пытаюсь создать макрос, который будет загружать файлы с веб-сайта PPA C. Код ниже работает безупречно, однако имя файла меняется каждый месяц и не всегда логично (ie, файл всегда будет содержать ddmmyyyy, но эта дата может быть любым днем ​​месяца).

Может Кто-нибудь помочь мне придумать способ загрузки файла с общим именем? Один маршрут, который, я надеюсь, будет полезен, это теги HTML - имя файла показано в следующем ниже

<H5>Installed Refinery Capacity</H5>
<ul>
<li>
<a href HERE LIES MY TARGET FILE ... </a>

Итак, точка под надписью «Установленная мощность НПЗ» содержит мой Имя файла, которое будет согласованным, за исключением даты. Могу ли я использовать это?

Другой вариант - l oop через несколько дат, пока я не выберу правильную, такой подход, я уверен, будет работать, но я не многому научусь ..

спасибо за руководство.

Sub DownloadFile()

Dim myURL As String

'myURL = "https://www.ppac.gov.in/WriteReadData/userfiles/file/PT_installed_24-04-2020.xls?your_query_parameters"
myURL = "https://www.ppac.gov.in/WriteReadData/userfiles/file/PT_installed_24-04-2020.xls"
'myURL = Cells(10, 3)


Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "username", "password"
WinHttpReq.send

If WinHttpReq.Status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.responseBody
    oStream.SaveToFile "C:\tmp\file.csv", 2 ' 1 = no overwrite, 2 = overwrite
    oStream.Close
End If

End Sub

Answer 1

Сделайте начальный запрос XmlHttp для

https://www.ppac.gov.in/content/146_1_ProductionPetroleum.aspx

Считайте .responseText в html.body.innerHTML экземплярной переменной MSHTML.HTMLDocument.

Соответствие подстроки с css атрибут = селектор значений (и содержит оператор *) для получения правильного href:

Dim link As String

link = html.querySelector("[href*='PT_installed']").href

Продолжайте код, используя эту ссылку.

---

Или как вспомогательная функция что-то вроде:

Public Sub DownloadFile()

    Dim myURL As String

    myURL = "https://www.ppac.gov.in" & GetLink("https://www.ppac.gov.in/content/146_1_ProductionPetroleum.aspx")

    Dim WinHttpReq As Object
    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    WinHttpReq.Open "GET", myURL, False, "username", "password"
    WinHttpReq.send

    If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.responseBody
        oStream.SaveToFile "C:\tmp\file.csv", 2 ' 1 = no overwrite, 2 = overwrite
        oStream.Close
    End If

End Sub

Public Function GetLink(ByVal url As String) As String
    Dim xhr As Object html As MSHTML.HTMLDocument 'required VBE > Tools > References > Microsoft HTML Object Library
    Set xhr = CreateObject("MSXML2.XMLHTTP")
    Set html = New MSHTML.HTMLDocument

    With xhr
        .Open "GET", url , False
        .send
        html.body.innerHTML = .responseText
    End With

    GetLink = html.querySelector("[href*='PT_installed']").href
End Function