Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.10.2025 17:40:39
16.10.2025 17:25:38
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Frage zu Outlook erlaubt?

Forumthread: Frage zu Outlook erlaubt?

Frage zu Outlook erlaubt?
02.04.2023 19:24:33
Frank

Hallo,

ist auch eine Frage rein zu Outlook erlaubt?
Wo anders müsste ich mich erst registrieren.

Ich speichere meine eingehenden Emails automatisch mit diesem Skript:

Private WithEvents InboxItems As Outlook.Items
Sub Application_Startup()
Dim xNameSpace As Outlook.NameSpace
Set xNameSpace = Outlook.Application.Session
Set InboxItems = xNameSpace.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub InboxItems_ItemAdd(ByVal objItem As Object)
Dim FSO
Dim xMailItem As Outlook.MailItem
Dim xFilePath As String
Dim xRegEx
Dim xFileName As String
On Error Resume Next
xFilePath = CreateObject("WScript.Shell").SpecialFolders(16)
xFilePath = xFilePath & "\Emails"
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(xFilePath) = False Then
FSO.CreateFolder (xFilePath)
End If
Set xRegEx = CreateObject("vbscript.regexp")
xRegEx.Global = True
xRegEx.IgnoreCase = False
xRegEx.Pattern = "\||\/|\|\>|""|:|\*|\\|\?"
If objItem.Class = olMail Then
Set xMailItem = objItem
xFileName = xRegEx.Replace(xMailItem.Subject, "")
xMailItem.SaveAs xFilePath & "\" & xFileName & ".html", olHTML
End If
Exit Sub
End Sub


Für meine Zwecke sehr gut, aber würde auch gerne die gesendeten Email so abspeichern.
Ist das überhaupt möglich?

Vielen Dank!

Gruß Frank

Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Frage zu Outlook erlaubt?
02.04.2023 20:22:11
mumpel
Hallo!

Stichwort: Application_ItemSend

kopierenplusminus

Option Explicit
Private WithEvents Items As Outlook.Items


Private Sub Application_Startup()
    Dim olApp       As Outlook.Application
    Dim olName      As Outlook.Namespace
    Dim olFolder    As Outlook.MAPIFolder


    Set olApp = Application
    Set olName = olApp.GetNamespace("MAPI")
    Set Items = olName.Session.Folders("Konto1").Folders("Posteingang").Items

Dim strAtt


Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)


Dim strArrBody As Variant
Dim olApp      As Outlook.Application
Dim olName     As Outlook.Namespace
Dim olFolder   As Outlook.MAPIFolder

On Error GoTo endError

      Set olApp = Application
      Set olName = olApp.GetNamespace("MAPI")

If (Item.MessageClass = "IPM.Note") Then
    ' Über Konto2 - speichern in "Konto1->Posteingang->Konto2->Ausgang" 

    If GetSetting("Konto1", "sendMail", "neueMail") = "1" Then
       SaveSetting "RMH Installationen", "sendMail", "neueMail", "0"
       Set olFolder = olName.Session.Folders("Konto2").Folders("Neue Mails")
       Set Item.SaveSentMessageFolder = olFolder
       Set olFolder = Nothing
       Set olName = Nothing
       Set olApp = Nothing
       Exit Sub
    End If

    If Item.SenderEmailAddress = "Konto2" Then
       Set olFolder = olName.Session.Folders("Konto").Folders("Posteingang").Folders("Konto2").Folders("Ausgang")
       Set Item.SaveSentMessageFolder = olFolder
       Set olFolder = Nothing
       Set olName = Nothing
       Set olApp = Nothing
       Exit Sub
    End If


    
    ' Über Konto3 - speichern in "René Holtz->Posteingang->BSW OV->Ausgang" 
    If Item.SenderEmailAddress = "email3@emailde" Then
       Set olFolder = olName.Session.Folders("Konto1").Folders("Posteingang").Folders("Konto1").Folders("Ausgang")
       Set Item.SaveSentMessageFolder = olFolder
       Set olFolder = Nothing
       Set olName = Nothing
       Set olApp = Nothing
       Exit Sub
    End If

strArrBody = Split(Item.Subject, ":=:")


   If strArrBody(0) = "Ihre Upload-Daten " Then
      Set olApp = Application
      Set olName = olApp.GetNamespace("MAPI")
      Set olFolder = olName.Session.Folders("Konto1").Folders("Posteingang").Folders("Upload-Formular").Folders("Ausgang")
      Set Item.SaveSentMessageFolder = olFolder
   End If
End If

endError:
On Error GoTo 0
End Sub



VBA/HTML-CodeConverter, AddIn für Office 2002 und höher (32-bit) und Microsoft 365 (32-bit Desktop-Version)
In VBA geschrieben von Lukas Mosimann. Projektbetreuung: René Holtz

Code erstellt und getestet in Microsoft 365 - 32-bit Desktopversion
Codedarstellung mit VBAHTML 01.2022 erstellt.
_________
Viel Erfolg
René



Anzeige
Nachtrag
02.04.2023 20:25:33
mumpel
Korrektur. Bei Application_Startup habe ich zuviel gelöscht. Daher fehlt ein "End Sub"

;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige