ich habe ein wunderbar funktionierendes Tool das eingehende Mails mit einem bestimmten Betreff in einem definierten Ordner speichert. Kann man diesen Code so verändern das man ihn neu ins Projekt hinzusetzt damit auch ausgehende Mails mit einem bestimmten Text im Betreff in einem weiteren Ordner gespeichert werden?
Würde mich freuen wenn mir jemand helfen kann.
MfG René
Private Sub Application_NewMailEx _
(ByVal EntryIDCollection As String)
Dim arr() As String
Dim i As Integer
Dim ns As Outlook.NameSpace
Dim itm As MailItem
Dim m As Outlook.MailItem
Dim MyBetreff As String
MyBetreff = "Epikrise"
On Error Resume Next
Set ns = Application.Session
arr = Split(EntryIDCollection, ",")
For i = 0 To UBound(arr)
Set itm = ns.GetItemFromID(arr(i))
If itm.Class = olMail Then
Set m = itm
Set myItem = Application.Session.GetDefaultFolder(olFolderInbox).Items(1)
myItem.Display
strname = m.Subject
strname = m.Subject
If InStr(1, strname, MyBetreff) = 0 Then
myItem.Close olSave
myItem.UnRead = True
Exit Sub
ElseIf InStr(1, strname, MyBetreff) 0 Then
strname = Replace(strname, ":", " ")
strname = Replace(strname, "/", " ")
End If
Dim strPrompt As String
m.SaveAs "Y:\Patientendaten\" & strname & " " & "Datum" & "_" & Day(Date) & "_" & Month( _
_
Date) & "_" & Year(Date) & "_" & "Uhrzeit" & "_" & Hour(Time) & "_" & Minute(Time) & ".msg", _
olMSG
myItem.Close olSave
myItem.UnRead = True
End If
Next
Set ns = Nothing
Set itm = Nothing
Set m = Nothing
End Sub