AW: Nachtrag: Ignoriere das erstmal
06.09.2020 13:40:50
Zwenn
Hallo Niclaus,
das mit dem IE kann man sich in der Tat komplett sparen. Ich gehe mal davon aus, dass der Grundlink sich nicht ändert. Das folgende Makro läd die aktuell vorliegende Datei runter und speichert sie in Deinem vorgegebenen Pfad. Ist der Download erfolgreich, wird die Datei direkt geöffnet.
Du kannst das Makro in Deiner persönlichen Exceldatei speichern, die beim Öffnen von Excel immer im Hintergrund mit geöffnet wird. Dann hast Du das Makro jederzeit zur Verfügung und musst Dich nicht weiter darum kümmern. Du kannst den Makronamen natürlich kürzen. Er ist jetzt recht sperrig.
Ich habe den Quelltext diesmal nicht kommentiert. Da war ich ehrlich gesagt zu faul zu ;-)
Ganz oben in das Modul, unter Option Explicit, kopierst Du die folgende Windows API Funktion. Die wird benötigt, um eine Datei direkt aus dem Internet runterzuladen. Sie ist schon so angepasst, dass sie sowohl unter Excel 32 Bit, wie auch unter Excel 64 Bit funktioniert.
#If Win64 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) As Long
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If
Darunter kopierst Du das folgende Makro. Du brauchst keine Verweise setzen, da ich alles mit late binding programmiert habe. Die Datei wird immer unter dem gleichen Namen gespeichert, weil man den mit vorgeben muss und ich nicht weiß, wie man den originalnamen des Downloads auslesen könnte. Das bedeutet, eine vorhandene Datei mit gleichem Namen wird ohne Rückfrage überschrieben. Wenn Du das nicht willst, kannst Du das Makro so ändern, dass eine vorhandene Datei vor dem Download automatisch umbenannt wird oder das die neu runtergeladene Datei direkt einen neuen Namen bekommt.
Sub downloadSwissLandesIndexKonsumentenPreise()
Const url As String = "https://www.bfs.admin.ch/asset/de/cc-d-05.02.08"
Const downloadPath As String = "C:\bfs\cc-d-05.02.08.xlsx"
Dim xhr As Object
Dim htmlDoc As Object
Dim downloadURL As String
Dim nodeAllLinks As Object
Dim nodeOneLink As Object
Set xhr = CreateObject("MSXML2.serverXMLHTTP")
Set htmlDoc = CreateObject("HTMLFile")
xhr.Open "GET", url, False
xhr.send
htmlDoc.body.innerHTML = xhr.responseText
Set nodeAllLinks = htmlDoc.getElementsByTagName("a")
For Each nodeOneLink In nodeAllLinks
If InStr(1, nodeOneLink.href, "master") > 0 Then
downloadURL = nodeOneLink.href
downloadURL = Replace(downloadURL, "about:", "https://www.bfs.admin.ch")
Exit For
End If
Next nodeOneLink
If URLDownloadToFile(0, downloadURL, downloadPath, 0, 0) = 0 Then
Workbooks.Open downloadPath
Else
MsgBox "Download fehlgeschlagen"
End If
End Sub
Der eigentliche Downloadvorgang funktioniert mit dem Code bei mir einwandfrei. Ich hoffe bei Dir auch.
Viele Grüße,
Zwenn