Outlook-Makro Ergänzungs-Hilfe
12.10.2023 06:41:48
BuddyHoli
ich verwende folgendes Makro in Outlook, um de Anhänge ausgewählter Emails in einen Ordner zu speichern. Dieses Makro kursiert so oder in abgewandelter Form hundertfach im Netz.
Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim objFileSystem As Object
Dim strFolderpath As String
' Outlook Application Objekt instanziieren
Set objOL = CreateObject("Outlook.Application")
' Collection der ausgewählten Objekte (E-Mails) ermitteln
Set objSelection = objOL.ActiveExplorer.Selection
' Ordner-Pfad festlegen, wo der E-Mail Anhang gespeichert werden soll
'HIER WIRD DER DATEIPFAD FESTGELEGT
strFolderpath = "c:Emails"
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
If Not objFileSystem.FolderExists(strFolderpath) Then
objFileSystem.CreateFolder (strFolderpath)
End If
' Jedes ausgewählten Objekte (E-Mails) prüfen, ob es einen Anhang hat. Wenn Anhang vorhanden,
' dann unter dem Ordnerpfad speichern.
For Each objMsg In objSelection
' Die Anhänge des ausgewählten Objekts (E-Mail) ermitteln
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
If lngCount > 0 Then
' Wir verwenden hier einen rückwärts gerichteten Zähler; umgekehrt sollte es aber auch funktionieren.
For i = lngCount To 1 Step -1
' Save attachment before deleting from item.
' Dateinamen ermitteln
strFile = objAttachments.Item(i).FileName
' Kombiniere Ablagepfad mit dem Dateinamen
strFile = strFolderpath & strFile
'Datei-Endung überprüfen
FileExtension = Right$(strFile, Len(strFile) - InStrRev(strFile, "."))
'HIER WIRD FESTGELEGT, WELCHE DATEIEN GESPEICHERT WERDEN SOLLEN, IN DIESEM BEISPIEL PDFs
If FileExtension = "pdf" Then
' Anhang als Datei speichern
objAttachments.Item(i).SaveAsFile strFile
End If
Next i
End If
Next
ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub
Das klappt auch prima, erstellt den angegebenen Ordner, falls er nicht vorhanden ist, usw.
Ich möchte gerne 2 Ergänzungen einbauen, doch da ich mich zwar mit Excel-Makros auskenne, hier aber völliges Neuland betrete, hoffe ich auf Hilfe:
1. Ich möchte, dass vor dem Speichern die Dateitypen ausgewählt werden können - beispielsweise durch die Eingabe einer kommagetrennten Liste wie "xls,pdf".
2. Ich möchte, dass der Speicherort jedes mal abgefragt wird, wobei der Dialog bei C: starten soll.
Ich hoffe, ihr könnt mir weiterhelfen.
Buddy