Thema Datum  Von Nutzer Rating
Antwort
Rot Outlook automatischer Download von Hyperlinks
02.05.2024 09:31:50 Mike
NotSolved
02.05.2024 11:02:02 Gast44060
*****
NotSolved
02.05.2024 11:21:44 Mike
NotSolved
02.05.2024 11:30:43 Gast96993
*****
NotSolved
02.05.2024 11:50:37 Mike
NotSolved
02.05.2024 11:59:49 Gast57315
*****
NotSolved
02.05.2024 12:01:28 Gast30342
Solved

Ansicht des Beitrags:
Von:
Mike
Datum:
02.05.2024 09:31:50
Views:
119
Rating: Antwort:
  Ja
Thema:
Outlook automatischer Download von Hyperlinks

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



 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausfĂŒhrlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf HĂ€ckchen)
  • Bei Crossposting, entsprechende Links auf andere ForenbeitrĂ€ge beifĂŒgen / nachtragen
  • Codeschnipsel am besten ĂŒber den Code-Button im Text-Editor einfĂŒgen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausfĂŒhrlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf HĂ€ckchen)
  • Bei Crossposting, entsprechende Links auf andere ForenbeitrĂ€ge beifĂŒgen / nachtragen
  • Codeschnipsel am besten ĂŒber den Code-Button im Text-Editor einfĂŒgen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Outlook automatischer Download von Hyperlinks
02.05.2024 09:31:50 Mike
NotSolved
02.05.2024 11:02:02 Gast44060
*****
NotSolved
02.05.2024 11:21:44 Mike
NotSolved
02.05.2024 11:30:43 Gast96993
*****
NotSolved
02.05.2024 11:50:37 Mike
NotSolved
02.05.2024 11:59:49 Gast57315
*****
NotSolved
02.05.2024 12:01:28 Gast30342
Solved