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
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
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.
Hi,
Zitat: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
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!
Hallo,
also ich bin sehr dafür, dass Du bei Office-Lösung Bescheid gibt, dass es hier gelöst wurde.
Gruß
Ein Frage noch dazu,
Wie muss ich den Code ändern, wenn die Formatierung kein direkter Hyperlink sondern in der Formel "=Hyperlink(…)" steht?
Oder:
Code:
Sub M_snb()
For Each it In Selection.Hyperlinks
FileCopy it.Address, Application.DefaultFilePath & "\" & Dir(it.Address)
Next
End Sub
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