Frage zu Outlook erlaubt?

Forumthread: 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

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Frage zu Outlook erlaubt?

02.04.2023 20:22:11

mumpel
Nachtrag

02.04.2023 20:25:33

mumpel

AW: Frage zu Outlook erlaubt?

02.04.2023 20:22:11

mumpel

Hallo!

Stichwort: Application_ItemSend

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é

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)

Forumthread: Frage zu Outlook erlaubt?

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread