Excel

Hyperlink per Makro öffnen und Datei herunterladen

Hyperlink per Makro öffnen

In diesem kleinen Beispiel zeige ich, wie Sie einen Hyperlink per Makro aus einer Zelle öffnen und die Datei von der Webseite herunterladen. In diesem Beispiel stehen die Links in den Zellen L19 und L20. Die Links sind als reiner Text hinterlegt und nicht mit der Formel HYPERLINK generiert worden. Alle Zeilen, die mit dem Kommentar <— anpassen versehen sind, müssen angepasst werden, wenn das Makro in eine andere Excel Datei eingefügt wird. Öffne den Visual Basic Editor (ALT+F11) und füge den folgenden Quelltext in ein Modul Deiner Arbeitsmappe ein :

Option Explicit

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
   Alias "URLDownloadToFileA" ( _
   ByVal pCaller As Long, _
   ByVal szURL$, _
   ByVal szFileName$, _
   ByVal dwReserved As Long, _
   ByVal lpfnCB As Long) As Long

Sub HyperLinkKopieren()
Dim Hl As Hyperlink
Dim rngBereich As Range          'Bereich, der nach Hyperlinks durchsucht wird
Dim strQuellDat As String        'Pfad + Datei, die kopiert werden soll
Dim strDatName As String         'Dateiname bei Dateien, die im Internet stehen

'Speicherort angeben
   Const strPfad As String = "C:\test\"       '<--- anpassen! - mit Backslash "\" abschließen!

'Existiert der Speicherort?
   If Dir(strPfad, vbDirectory) = "" Then
      MsgBox "Der angegebene Pfad ist ungültig!" & vbLf & vbLf & _
               "Bitte richtigen Pfad im Code angeben!" & vbLf & vbLf & _
               "Das Makro bricht ab!"
                
      Exit Sub
   End If

'Bereich, der nach Hyperlinks durchsucht wird angeben:
   With ThisWorkbook.Worksheets("Tabelle1")           '<--- anpassen!
      Set rngBereich = .Range("L19:L20")              '<--- anpassen!
   End With

'Schleife über alle Hyperlinks in diesem Bereich
   For Each Hl In rngBereich.Hyperlinks
      strQuellDat = Hl.Address                                                      'Quelldatei
      Debug.Print "Quelldatei : " & strQuellDat
      If LCase(Left(strQuellDat, 4)) = "http" Then                                  'Quelldatei online
         strDatName = Split(strQuellDat, "/")(UBound(Split(strQuellDat, "/")))      'Dateiname
         Debug.Print URLDownloadToFile(0, strQuellDat, strPfad & strDatName, 0, 0)  'herunterladen
      Else                                                                          'Quelldatei offline
         FileCopy strQuellDat, strPfad & Dir(strQuellDat, vbNormal)                 'Speichern unter
      End If
   Next
    
'aufräumen:
   Set rngBereich = Nothing
   Set Hl = Nothing
End Sub

Kurze Erklärung zum Quelltext :

  • In Zeile 3 wird der Windows API Befehl URLDownloadToFile deklariert, womit eine Datei aus dem Intranet oder Internet heruntergeladen werden kann.
  • In Zeile 18 wird das Zielverzeichnis festgelegt, wo alle Downloads drin gespeichert werden. Der Pfad muss immer einen abschließenden Backslash haben.
  • In Zeile 30-31 wird der Bereich festgelegt, wo das Makro nach Hyperlinks suchen soll. Hier dem Quelltext sind das die Zellen L19 bis L20.
  • In Zeile 35-44 wird jede Zelle einzeln über die Schleife abgefragt ob es sich um einen Hyperlink (Intranet / Internet) handelt. Wenn ja, wird die Datei aus dem Intranet / Internet heruntergeladen. Wenn nein, wird nur eine Kopie von der Datei von dem angegebenen Laufwerk durchgeführt. Alle Dateien werden in das Verzeichnis gespeichert, welches in Zeile 18 definiert wurde.

Bei diesem Beispiel ist Voraussetzung, dass sich der Dateiname der zu herunterladenen Datei am Ende des Hyperlinks befindet (Beispiel : http://www.domain.tld/verz1/verz2/Testdatei.pdf). Hat der Hyperlink nicht das Format aus dem Beispiel, so muss die Zeile 39 entsprechend angepasst werden. Dieses Makro funktioniert mit Office 32Bit und 64Bit und ab Office 2010 oder höher.

8 Gedanken zu „Hyperlink per Makro öffnen und Datei herunterladen

  1. Hallo, so etwas ähnliches suche ich schon länger.
    Wäre das auch aus einem Word File möglich. Links als „richtige“ Hyperlinks vorhanden.

    Als Kür dann
    die Word-Datei unter einem neuen Namen abspeichern und die Hyperlinks abzuändern in den neuen Speicherort wo alle downgeloadeten Dateien sich befinden ?

  2. Ich habe es dank der Anleitung hingekriegt. Habe allerdings noch ein Problem, mit dem Phänomen, das ganz am Ende beschrieben ist: „Hat der Hyperlink nicht das Format aus dem Beispiel, so muss die Zeile 39 entsprechend angepasst werden.“ Da ich solche Hyperlinks habe: Wie muss ich denn dann anpassen?
    Gibt es einen Weg, die Dateinamen dann automatisch zu erzeugen (Hyperlinks stehen in Spalte A, gewünschte Dateinamen in Spalte B -> Makro soll jeden Download aus Spalte A den jeweiligen Namen aus Spalte B (ggfs. auch noch unterschiedliche Verzeichnisse, die noch in einer weiteren Spalte stehen??) geben.

  3. Hallo Gemeinde,
    In der Beschreibung steht: Öffne den Visual Basic Editor (ALT+F11) und füge den folgenden Quelltext in ein Modul Deiner Arbeitsmappe ein .

    Wenn ich ( Lehtling ) den kompletten Code in ein VBA-Modul einsetze, dann wird bis zu Zeile 9 alles rot und ich komme nicht weiter;
    Mus neben „paste and copy“ noch was gemacht werden,??
    Oder Ist mein Win 7 nicht ausreichend???
    Requirements : Minimum supported client Windows XP ???
    Minimum supported server Windows 2000 Server ???

Schreibe einen Kommentar

Deine E-Mail-Adresse wird nicht veröffentlicht. Erforderliche Felder sind mit * markiert.