Datei hinter Hyperlink per Befehlsschaltfläche exportieren

[MarcoH83]

Hola,

zum Glück lebt das Forum noch :) ich benötige mal wieder Eure Hilfe.

ich möchte per Knopfdruck alle Dateien hinter den Hyperlinks in den Ordner der .xlsx speichern.

Die Mappe liegt in "G:\Technik\SAP\Export\…"
die Hyperlinks dazu in Spalte "AG"
und haben eine Standard Formatierung und heißen wie folgt "\\SAP01\SAP-Dateien\Dateianhänge\....pdf"

Die Hyperlinks sind Teilweise doppelt und es gibt auch leere Zeilen.

Da ich nicht viel Ahnung von VBA habe wäre nett wenn mir einer von euch helfen könnte.

Vielen Dank!
Gruß Marco

[chris-ka]

Hi,

Code:

Option Explicit

Private Declare Function DeleteUrlCacheEntry Lib "wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
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
Sub hypertext_in_Ordner()
Dim StrPath As String
Dim lngRow As Long
For lngRow = 2 To Cells(Rows.Count, "AG").End(xlUp).Row 'ich starte ab Zeile 2 in Spalte A 'ggf ändern
    StrPath = Cells(lngRow, "AG").Value
        If Cells(lngRow, "AG").Hyperlinks.Count > 0 Then
            URLDownloadToFile 0, StrPath, ThisWorkbook.Path & "\" & StrReverse(Split(StrReverse(StrPath), "\")(0)), 0, 0
        End If
Next
End Sub

[MarcoH83]

Hallo Chris,

vielen Dank schonmal für deine Antwort.

Ich habe den Code komplett per Code anzeigen in die Schaltfläche eingefügt.

Es passiert jedoch nichts.

[chris-ka]

Hi,

Da ich nicht viel Ahnung von VBA habe ...

Öffne deine Datei
drücke Alt+F11
Menü -> Einfügen Modul
kopiere diesen Code in dieses Modul hinein.
im Register Entwicklertools füge aus Steuerelemente eine Schaltfläche ein. (falls noch nicht da Register hinzufügen mit Menüband anpassen)
Bei eingeschaltetem Entwurfsmodus vergebe bei "Klick" den Eintrag (dplklick auf die Schaltfläche)
hypertext_in_Ordner
auf die Schaltfläche
Schließe das VBE Fenster
Speichere  die Datei mit Makros ab!
und fertisch ;)
anbei noch als Video
https://www.youtube.com/watch?v=3VGO_O8HKfM

[MarcoH83]

Okey, jetzt funktioniert es halbwegs, denn bei der zweiten Leerzeile stoppt der Export.

Edit: funktioniert! Lag daran dass meine Hyperlinks nur wie solche aussahen.

Vielen Dank für dein schnelle Hilfe!

[maninweb]

Hallo,

also ich bin sehr dafür, dass Du bei Office-Lösung Bescheid gibt, dass es hier gelöst wurde.

Gruß

[MarcoH83]

erledigt

[MarcoH83]

Ein Frage noch dazu,

Wie muss ich den Code ändern, wenn die Formatierung kein direkter Hyperlink sondern in der Formel "=Hyperlink(…)" steht?

[snb]

Oder:

Code:

Sub M_snb()
   For Each it In Selection.Hyperlinks
      FileCopy it.Address, Application.DefaultFilePath & "\" & Dir(it.Address)
   Next
End Sub

[chris-ka]

Hi,

versuche mal
If Cells(lngRow, "AG").Hyperlinks.Count > 0 Or Cells(lngRow, "AG").Formula Like "=HYPER*" Then

diese Zeile mit dem fett geschrieben Text  zu ergänzen