Office: (Office 365) Makro Zip-Datei von Webseite runterladen, auspacken, kopieren

Helfe beim Thema Makro Zip-Datei von Webseite runterladen, auspacken, kopieren in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo Zusammen, ich habe ein Makro gefunden von dem ich denke, dass es koennen sollte was ich braeuchte, eine Datei herunterladen, auspacken und den... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von mbrokof, 12. April 2024.

  1. Makro Zip-Datei von Webseite runterladen, auspacken, kopieren


    Hallo Zusammen,

    ich habe ein Makro gefunden von dem ich denke, dass es koennen sollte was ich braeuchte, eine Datei herunterladen, auspacken und den Inhalt in die Datei kopieren in der das Makro gestartet wird. Wenn ich den Link eingebe kommt Datei nicht gefunden, oder es stoppt in der Zeile Csvfile. Weiter bin ich noch nicht gekommen, weil ich nicht weiss, was der Fehler ist.

    Sub DownloadZipExtractCsvAndLoad_01()
    'ZVI:2017-01-07 Need vba to download and copy the data from zip file
    'ZVI:2018-09-11 Updated code with destination range constants

    ' --> User settings, change to suit
    Const DestSheet = "F_X-Rates"
    Const DestCell = "C4"
    '<-- End of the user settings

    Dim UrlFile As String, ZipFile As String, CsvFile As String, Folder As String, s As String, DestWorkbook As String

    ' UrlFile to the ZIP archive with CSV file
    UrlFile = "https://www.ecb.europa.eu/stats/eurofxref/eurofxref-hist.zip?2baf28632f50dcbc1dc5a7c2328464fd"

    ' Extract ZipFile, CsvFile from UrlFile
    ZipFile = Mid(UrlFile, InStrRev(UrlFile, "/") + 1)
    CsvFile = Left(ZipFile, Len(ZipFile) - 4)

    ' Define temporary folder (updated 2018-09-11)
    Folder = Environ("TEMP")
    If Right(Folder, 1) <> "\" Then Folder = Folder & "\"

    ' Disable screen updating to avoid blinking
    Application.ScreenUpdating = False

    ' Trap errors
    On Error GoTo exit_

    ' Download UrlFile to ZipFile in Folder
    If Not Url2File(UrlFile, Folder & ZipFile) Then
    MsgBox "Can't download file" & vbLf & UrlFile, vbCritical, "Error"
    Exit Sub
    End If

    ' Extract CsvFile from ZipFile
    If Len(Dir(Folder & CsvFile)) Then Kill Folder & CsvFile
    With CreateObject("Shell.Application").Namespace((Folder))
    .CopyHere Folder & ZipFile & "\" & CsvFile
    End With
    Kill Folder & ZipFile

    ' Delete temporary folders to prevent saturation of Shell.Application
    With CreateObject("Scripting.FileSystemObject")
    s = Dir(Folder & "\*" & ZipFile, vbDirectory + vbHidden)
    While Len(s)
    .DeleteFolder Folder & s, True
    s = Dir()
    Wend
    End With

    ' Import CsvFile to Excel
    With Workbooks.Open(Folder & CsvFile).Sheets(1)
    .UsedRange.Columns(1).TextToColumns Destination:=.Cells(1), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
    FieldInfo:=Array(Array(3, 4), Array(15, 4)), TrailingMinusNumbers:=True
    ' Autofit the widths
    .UsedRange.Columns.AutoFit

    ' Copy sheet to the new workbook
    '.Copy

    ' Copy data to the destination range (updated 2018-09-11)
    .UsedRange.Copy Workbooks(DestWorkbook).Sheets(DestSheet).Range(DestCell)

    ' Release (close) CsvFile
    .Parent.Close False
    End With

    ' Delete CsvFile
    Kill Folder & CsvFile

    exit_:

    ' Restore screen updating
    Application.ScreenUpdating = True

    ' Inform about the reason of the trapped error
    If Err Then MsgBox Err.Description, vbCritical, "Error"

    End Sub

    Function Url2File(UrlFile As String, PathName As String, Optional Login As String, Optional Password As String) As Boolean
    'ZVI:2017-01-07 Download UrlFile and save it to PathName.
    ' Use optional Login and Password if required.
    ' Returns True on success downloading.
    Dim b() As Byte, FN As Integer
    On Error GoTo exit_
    If Len(Dir(PathName)) Then Kill PathName
    With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", UrlFile, False, Login, Password
    .send
    If .Status <> 200 Then Exit Function
    b() = .responseBody
    FN = FreeFile
    Open PathName For Binary Access Write As FN
    Put FN, , b()
    exit_:
    If FN Then Close FN
    Url2File = .Status = 200
    End With
    End Function

    Kann es sein, dass die obige Version nicht auf Excel 365 laeuft? Ich kann auf den Temp- Ordner nicht zugreifen, falls es daran liegt.

    Beste Gruesse
    Matthias
     
    mbrokof, 12. April 2024
    #1
  2. PIVPQ hat Ahnung
    Hallo
    Mein Tipp:
    Lade dir deine Zip Datei über deinen Browser herunter und entpacke sie, anschließend importiere deine csv. Dateien mit Power Query und bearbeite sie nach Wunsch.
    Dies funktioniert ganz prima von deinem gezeigten Link, dazu brauchst du kein VBA.
     
  3. Exl121150 Erfahrener User
    Hallo,
    Ich nehme an, dass du folgende Zeile in das Makro hineinkopiert hast:
    UrlFile = "https://www.ecb.europa.eu/stats/eurofxref/eurofxref-hist.zip?2baf28632f50dcbc1dc5a7c2328464fd"
    um damit die Inhalte der Zip-Datei in ein Excel-Arbeitsblatt zu kopieren. Was du nicht bedacht hast, dass dieser URL sich aus mehreren Bestandteilen zusammensetzt:
    https:// bezeichnet das Protokoll,
    www.ecb.europa.eu bezeichnet die Hierarchie der Domains
    /stats/eurofxref/ den Pfad in vorgenannter www.ecb-Domain
    eurofxref-hist.zip die dort vorhandene Zip-Datei
    ?
    2baf28632f50dcbc1dc5a7c2328464fd einen Abfrageparameter für die Zip-Datei.

    Du hast aber den Abfrageparameter als Bestandteil des Zip- und Csv-Dateinamens belassen, was so nicht funktionieren konnte.

    Ich habe das Makro an mehreren Stellen ergänzt:
    1) Ich habe der Variablen "DestWorkbook" den Namen der Arbeitsmappe zugewiesen, die dieses Makro enthält:
    DestWorkbook = ThisWorkbook.Name
    Dabei muss aber auch in dieser Arbeitsmappe ein Arbeitsblatt mit dem Namen "F_X-Rates" existieren, in welches die Daten kopiert werden.

    2) Ich habe getestet, ob der URL ein ?-Zeichen enthält und entsprechend den Zip- u. Csv-Dateinamen modifiziert:
    Code:
       posQuest = InStr(ZipFile, "?")                        
    
       If posQuest Then ZipFile = Left(ZipFile, posQuest - 1)
     
       If LCase$(Right(ZipFile, 4)) = ".zip" Then            
          CsvFile = Left(ZipFile, Len(ZipFile) - 4) & ".csv"    
       Else                                                      
          CsvFile = ZipFile & ".csv"                            
       End If           

    3) Ich habe an folgender Stelle den Pfad korrigiert:
    s = Dir(Folder & ZipFile, vbDirectory + vbHidden)

    Nachfolgend nochmals das gesamte Makro:
    Code:
    Sub DownloadZipExtractCsvAndLoad_01()
       'ZVI:2017-01-07 Need vba to download and copy the data from zip file
       'ZVI:2018-09-11 Updated code with destination range constants
      
       ' --> User settings, change to suit
       Const DestSheet = "F_X-Rates"
       Const DestCell = "C4"
       '<-- End of the user settings
      
       Dim UrlFile As String, ZipFile As String, CsvFile As String, Folder As String, s As String, DestWorkbook As String
       Dim posQuest As Long
      
       ' UrlFile to the ZIP archive with CSV file
       UrlFile = "https://www.ecb.europa.eu/stats/eurofxref/eurofxref-hist.zip?2baf28632f50dcbc1dc5a7c2328464fd"
      
       ' Name der Arbeitsmappe, in der sich dieses Makro befindet '<===(updated 2024-04-13)
       DestWorkbook = ThisWorkbook.Name                           '<===
      
       ' Extract ZipFile, CsvFile from UrlFile
       ZipFile = Mid(UrlFile, InStrRev(UrlFile, "/") + 1)
       posQuest = InStr(ZipFile, "?")                             '<===(updated 2024-04-13)
       If posQuest Then ZipFile = Left(ZipFile, posQuest - 1)     '<===
      
       If LCase$(Right(ZipFile, 4)) = ".zip" Then                 '<===
          CsvFile = Left(ZipFile, Len(ZipFile) - 4) & ".csv"      '<===
       Else                                                       '<===
          CsvFile = ZipFile & ".csv"                              '<===
       End If                                                     '<===
      
       ' Define temporary folder (updated 2018-09-11)
       Folder = Environ("TEMP")
       If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
      
       ' Disable screen updating to avoid blinking
       Application.ScreenUpdating = False
      
       ' Trap errors
       On Error GoTo exit_
      
       ' Download UrlFile to ZipFile in Folder
       If Not Url2File(UrlFile, Folder & ZipFile) Then
          MsgBox "Can't download file" & vbLf & UrlFile, vbCritical, "Error"
          Exit Sub
       End If
      
       ' Extract CsvFile from ZipFile
       If Len(Dir(Folder & CsvFile)) Then Kill Folder & CsvFile
       With CreateObject("Shell.Application").Namespace((Folder))
          .CopyHere Folder & ZipFile & "\" & CsvFile
       End With
       Kill Folder & ZipFile
      
       ' Delete temporary folders to prevent saturation of Shell.Application
       With CreateObject("Scripting.FileSystemObject")
          s = Dir(Folder & ZipFile, vbDirectory + vbHidden)    '<===(updated 2024-04-13) kein "\*" !
          While Len(s)
             .DeleteFolder Folder & s, True
             s = Dir()
          Wend
       End With
      
       ' Import CsvFile to Excel
       With Workbooks.Open(Folder & CsvFile).Sheets(1)
          .UsedRange.Columns(1).TextToColumns Destination:=.Cells(1), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
                FieldInfo:=Array(Array(3, 4), Array(15, 4)), TrailingMinusNumbers:=True
          ' Autofit the widths
          .UsedRange.Columns.AutoFit
        
          ' Copy sheet to the new workbook
          '.Copy
        
          ' Copy data to the destination range (updated 2018-09-11)
          .UsedRange.Copy Workbooks(DestWorkbook).Sheets(DestSheet).Range(DestCell)
        
          ' Release (close) CsvFile
          .Parent.Close False
       End With
      
       ' Delete CsvFile
       Kill Folder & CsvFile
      
    exit_:
      
       ' Restore screen updating
       Application.ScreenUpdating = True
      
       ' Inform about the reason of the trapped error
       If Err Then MsgBox Err.Description, vbCritical, "Error"
    
    End Sub
    
    Function Url2File(UrlFile As String, PathName As String, Optional Login As String, Optional Password As String) As Boolean
       'ZVI:2017-01-07 Download UrlFile and save it to PathName.
       ' Use optional Login and Password if required.
       ' Returns True on success downloading.
       Dim b() As Byte, FN As Integer
       On Error GoTo exit_
       If Len(Dir(PathName)) Then Kill PathName
       With CreateObject("MSXML2.XMLHTTP")
          .Open "GET", UrlFile, False, Login, Password
          .send
          If .Status <> 200 Then Exit Function
          b() = .responseBody
          FN = FreeFile
          Open PathName For Binary Access Write As FN
          Put FN, , b()
    exit_:
          If FN Then Close FN
          Url2File = .Status = 200
       End With
    End Function
    
     
    Exl121150, 13. April 2024
    #3
    1 Person gefällt das.
  4. Makro Zip-Datei von Webseite runterladen, auspacken, kopieren

    Hallo Anton Exl,
    super vielen Dank. Das werde ich sofort ausprobieren.
    Beste Gruesse und einen schoenen Sonntag noch.
    Matthias
     
    mbrokof, 14. April 2024
    #4
  5. Funktioniert mit dem Herunterladen. Ich hätte noch zwei Fragen unten. Zu deinen Anmerkungen:
    Zu 1) Ja, ein Arbeitsblatt mit dem Namen oder ggf. anderem Namen entsprechend dem was von der EZB kommt habe ich eingefügt. Danke für den Hinweis und die Aenderung.
    zu 2) Enthaelt die URL ein Fragezeichen? Hintergrund der Frage ist, dass sich die URL zu verschiedenen Zeiten zu ändern scheint und ich versucht habe es zu verallgemeinern. In Excel in einer Zelle die URL vom ? bis zum Ende durch &"*" ersetzt und angeklickt lädt die Datei herunter, aber im Makro so eingefügt funktioniert es nicht. Auf der Ursprungsseite gab es zu ändernden URL's noch dies hier:
    "
    UrlFile = "
    https://www.nseindia.com/content/EQUITIES/" & [TEXT(NOW(),"YYYY/MMM/c\mDDMMMYYYY")] & "bhav.csv.zip""
    bzw. das "
    Dim MonthName As String
    MonthName = [TEXT(NOW(),"MMM")]
    UrlFile = "https://www.nseindia.com/content/EQUITIES/" & [TEXT(NOW(),"YYYY/MMM/c\mDDMMMYYYY")] & "bhav.csv.zip"
    UrlFile = Replace(UrlFile, MonthName, UCase(MonthName))"
    Ist es moeglich den Link so zu aendern, dass man nicht auf die Seite gehen muss um ihn zu kopieren?
    Zu 3) War die Korrektur um es an den Teil Extract Csvfile from Zipfile mit dem Ordner anzupassen?

    Gibt es in dem Makro einen Teil der sich auf das amerikanische Datumssystem Monat/Tag bezieht? Die Datei der EZB zeigt das Datum Tag/Monat/Jahr an. Nachdem kopieren kommt bei mir Monat/Tag/Jahr raus. Habe es eben auf dem Desktop versucht und da kommt dasselbe raus. Was mir dabei auffiel war, dass die Daten sich zu ändern scheinen. Wenn der Tag über den 12. hinausgeht wird das Datum Tag/Monat/Jahr angezeigt, wenn nicht Monat/Tag/Jahr. Damit funktioniert die Durchschnittsformel dann anscheinend nicht mehr. Anbei ein Bildschirmdruck mit dem was ich meine.
     
    mbrokof, 14. April 2024
    #5
  6. Exl121150 Erfahrener User
    Hallo,

    was ich nicht überprüft hatte, war, ob die CSV-Spaltentypen richtig erkannt und widergegeben werden, da du diesbezüglich keine Probleme mitgeteilt hattest.
    Du hattest folgende Einstellungen:
    Code:
          .UsedRange.Columns(1).TextToColumns Destination:=.Cells(1), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
                FieldInfo:=Array(Array(3, 4), Array(15,4)), TrailingMinusNumbers:=True
    
    Korrekt kann aber nur Folgendes sein, denn nur die 1. Spalte enthält Datumsangaben und zwar im Format "JJJJ-MM-TT". Warum du eine 3. Spalte und eine 15. Spalte ebenfalls im DMY-Quellformat angeführt hast, ist mir sowieso schleierhaft.
    Code:
          .UsedRange.Columns(1).TextToColumns Destination:=.Cells(1), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
                FieldInfo:=Array(Array(1, 5)), TrailingMinusNumbers:=True
    

    Nachfolgend die Codes für die 2.Zahl in Array(1,5) - also statt der Fünf:
    Makro Zip-Datei von Webseite runterladen, auspacken, kopieren upload_2024-4-14_16-45-55.png
     
    Exl121150, 14. April 2024
    #6
  7. Morgen Anton,

    tut mir leid, das war mir nicht klar, kam vom Original. Vielen Dank für den Änderungsvorschlag. Es funktioniert.
    Kann man was wegen des Textes machen? Ich werde die naechsten Tage beobachten, ob sich der Text wieder aendert und
    schauen, ob ich die Formel aendern kann.
    Gibt es ein Buch zu obigem zu lernen? Ich habe was von Rheinwerk, aber keine Ahnung ob das fuer sowas wie oben gut genug ist.
     
    mbrokof, 15. April 2024
    #7
  8. Exl121150 Erfahrener User

    Makro Zip-Datei von Webseite runterladen, auspacken, kopieren

    Hallo,

    was meinst du mit dieser Frage?

    Falls du mit dieser Frage den Aufbau und die Auswertung des folgenden URLs meinst:
    'UrlFile = "https://www.ecb.europa.eu/stats/eurofxref/eurofxref-hist.zip?2baf28632f50dcbc1dc5a7c2328464fd"
    das habe ich dir doch ins Makro eingebaut, dass der Teil nach dem Fragezeichen übergangen wird und habe dir das extra im Punkt 2) erläutert, dass dieser Makroabschnitt dafür zuständig ist.
     
    Exl121150, 15. April 2024
    #8
    1 Person gefällt das.
  9. Entschuldige, dann habe ich es falsch verstanden. Ich dachte bzw. habe zwar verstanden, dass Du die URL getestet und den Code modifiziert hast, aber nicht, dass das auch dazu geführt hat, dass die Endung der URL quasi übergangen wird.
    Das ist spitze, Vielen Dank nochmal.
     
    Zuletzt bearbeitet: 16. April 2024
    mbrokof, 16. April 2024
    #9
  10. mbrokof, 16. April 2024
    #10
Thema:

Makro Zip-Datei von Webseite runterladen, auspacken, kopieren

Die Seite wird geladen...
  1. Makro Zip-Datei von Webseite runterladen, auspacken, kopieren - Similar Threads - Makro Zip Datei

  2. VBA-Makro zur Zellenformatierung Syntax probleme

    in Microsoft Excel Hilfe
    VBA-Makro zur Zellenformatierung Syntax probleme: Hallo zusammen, ich möchte per Makro Zellen formatieren. Tausender-Trennzeichen 3 Nachkommastellen Positive Zahlen Schwarz Negative Zahlen Rot Nullwert mit - Hinter der Zahl soll noch eine...
  3. Rechnungsvorlage mit Kundenstamm ohne Makro

    in Microsoft Excel Hilfe
    Rechnungsvorlage mit Kundenstamm ohne Makro: Hallo zusammen, habe folgendes Problem. Habe eine Liste mit Kunden. In dieser Liste sind Waren dem jeweiligen Kunden Artikel mit Preis und Packschema hinterlegt. Ich habe eine Rechnungsvorlage...
  4. Word-Dateien über Excel in eine ausgewählte Word-Datei übertragen per Makro

    in Microsoft Excel Hilfe
    Word-Dateien über Excel in eine ausgewählte Word-Datei übertragen per Makro: Hallo Zusammen, ich hoffe es kann mir jemand weiterhelfen in dem Forum. Ich habe ein Makro in der Excel-Datei (Reiter: Datenbank) im Anhang, wo ich mir von allen Word-Dateien den Pfad und den...
  5. Probleme mit Makro das jede Zeile in der ein "Text" steht löscht?!

    in Microsoft Excel Hilfe
    Probleme mit Makro das jede Zeile in der ein "Text" steht löscht?!: Hallo Leute, Ich habe mal wieder ein Problem, ich hoffe ihr könnt mir hier helfen! :) Habe hier schon ein Makro soweit, aber es macht halt noch nicht genau das was es soll, woran ich natürlich...
  6. Symbol per Makro einfügen

    in Microsoft Excel Hilfe
    Symbol per Makro einfügen: Hallo zusammen, ich habe aktuell folgendes in meiner Excel mittels bedingter Formatierung implementiert: Bei verschiedenen Zahlen, die in die Zellen A1-A5 eingetragen werden, werden diese durch...
  7. Makro für variable Anzahl von Datensätzen

    in Microsoft Excel Hilfe
    Makro für variable Anzahl von Datensätzen: Hallo zusammen, ich habe wieder einmal ein kleines Excel-Problem, bei dem Ihr mir sicherlich helfen könnt. Ich habe eine Excel-Liste, das ist ein Export aus einem anderen Programm (siehe...
  8. Makro aus personal.xls starten

    in Microsoft Excel Hilfe
    Makro aus personal.xls starten: Auf einem Arbeitsblatt habe ich mehrere Buttons. Die zugehörigen Makros sind in personal.xls gespeichert. Aus dem Code-Editor heraus kann ich die Makros ohne Problem starten. auf dem Arbeitsblatt...
Schlagworte:
  1. Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
    Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
    Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.
    Information ausblenden