Hallo in die Runde!
ich bekomme häufig E-Mails in Outlook wo mehrere Hyperlinks zu PDF-Dateien enthalten sind. Diese muss ich einzeln anklicken und herunterladen. Um mir diese Arbeit zu erleichtern habe ich nach Makros gesucht und einen Code im Netz gefunden. Leider lädt das Makro immer nur eine der Dateien von den vielen Hyperlinks herunter und nicht alle. Meine VBA Kentnisse sind leider sehr gering. Eigentlich geht er mit der Zeile
"For Each oLink In oRng.hyperlinks"
ja die einzelnen Hyperlinks durch aber das scheint nicht zu funktionieren.
Hat jemand eine Idee wo der Fehler liegt?
Vielen Dank im vorraus!
Option Explicit
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 GetMsg()
Dim olMsg As MailItem
On Error Resume Next
Set olMsg = ActiveExplorer.Selection.item(1)
DownloadLinkedFile olMsg
lbl_Exit:
Exit Sub
End Sub
Sub DownloadLinkedFile(olItem As MailItem)
Dim olEmail As Outlook.MailItem
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim oLink As Object
Dim vAddr As Variant
Dim strFName As String
Dim strURL As String
Dim strLocal As String
Const strPath As String = "C:\ xxxxxx" 'Pfad auswählen)
On Error Resume Next
With olItem
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
For Each oLink In oRng.hyperlinks
If Right(LCase(oLink.Address), 3) = "pdf" And _
Left(LCase(oLink.Address), 4) = "http" Then
vAddr = Split(oLink.Address, "/")
strFName = vAddr(UBound(vAddr))
strURL = oLink.Address
End If
Next oLink
End With
strLocal = strPath & strFName 'here the drive and download directory
If URLDownloadToFile(0, strURL, strLocal, 0, 0) = 0 Then
MsgBox strFName & " - downloaded"
Else
MsgBox strFName & " - download failed"
End If
lbl_Exit:
Set olInsp = Nothing
Set oRng = Nothing
Set oLink = Nothing
Exit Sub
End Sub
|