Einfacher E-Mail-Management: Speichern Sie Anhänge und Inhalte automatisch in Ordnern

In diesem Beitrag werde ich Ihnen zeigen, wie Sie mit wenigen VBA-Zeilen in Outlook automatisch E-Mails in separaten Ordnern basierend auf dem Betreff speichern können. Darüber hinaus lernen Sie, wie Sie den Inhalt der E-Mail automatisch als Textdatei und jegliche Anhänge in demselben Ordner speichern können. Klingt kompliziert? Keine Sorge, mit der Schritt-für-Schritt-Anleitung wird es ein Kinderspiel!

Private WithEvents inboxItems As Outlook.Items

Private Sub Application_Startup()
Dim ns As Outlook.NameSpace
Set ns = Application.GetNamespace("MAPI")
Set inboxItems = ns.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub inboxItems_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
SaveEmailAndAttachments Item
End If
End Sub

Sub SaveEmailAndAttachments(ByVal mail As Outlook.MailItem)
Dim saveFolder As String
Dim subject As String
Dim mailTextFile As String

'Pfad, wo die Ordner erstellt werden sollen
saveFolder = "C:\Emails\" 'Ändern Sie dies nach Bedarf

'Verwenden Sie den Betreff der E-Mail, um den Ordner zu benennen
subject = mail.Subject
'Ersetzen Sie ungültige Zeichen
subject = ReplaceCharsForFileName(subject, "_")
saveFolder = saveFolder & subject & "\"

'Erstelle den Ordner
MkDir saveFolder

'Speichern Sie den E-Mail-Text in einer Textdatei
mailTextFile = saveFolder & "EmailText.txt"
SaveTextToFile mail.Body, mailTextFile

'Speichern Sie Anhänge, falls vorhanden
Dim attachment As Outlook.Attachment
For Each attachment In mail.Attachments
attachment.SaveAsFile saveFolder & attachment.FileName
Next attachment
End Sub

Function ReplaceCharsForFileName(ByVal sName As String, ByVal sChar As String) As String
Dim sBadChars As String
Dim i As Long
sBadChars = "\/:*?""<>|"
For i = 1 To Len(sBadChars)
sName = Replace(sName, Mid(sBadChars, i, 1), sChar)
Next i
ReplaceCharsForFileName = sName
End Function

Sub SaveTextToFile(ByVal sText As String, ByVal sFile As String)
Dim oFSO As Object
Dim oFile As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFile = oFSO.CreateTextFile(sFile)
oFile.WriteLine sText
oFile.Close
Set oFile = Nothing
Set oFSO = Nothing
End Sub

Wichtiger Hinweis:

• Dieses Skript wird nur für neue E-Mails, die nach der Einrichtung des Skripts eintreffen, funktionieren.
• Sie müssen die Sicherheitseinstellungen von Outlook überprüfen, da der Zugriff über VBA beschränkt sein könnte.
• Passen Sie den saveFolder-Pfad an Ihre Bedürfnisse an.
• Der Code erstellt nicht rekursiv Ordner, daher muss der übergeordnete Pfad (in diesem Beispiel “C:\Emails”) bereits existieren.
• Beachten Sie, dass es bei der automatischen Verarbeitung von E-Mails zu unerwarteten Problemen kommen kann, insbesondere wenn Sie eine große Anzahl von E-Mails erhalten. Es ist ratsam, den Code zuerst in einer sicheren Umgebung zu testen.