Mail-Anhang abspeichern und Body-Text als txt abspeichern

Hallo!

Ich möchte ein Makro bauen, welches per Regel-Assistent ausgeführt wird. Dieses soll Attachments in einem Pfad abspeichern und den Mitteilungstext (Body-Text der Mail) als txt-Datei abspeichern. Dazu habe ich schon zwei Beispiele gefunden, die ich jedoch nicht zusammenfügen kann. Könntet ihr mir helfen?

Mail-Inhalt speichern (sollte aber nur den Body speichern):
Code:

Public Enum olSaveAsTypeEnum
olSaveAstxt = 0
End Enum

Private WithEvents Items As Outlook.Items

Private Const MAIL_PATH As String = \“c:\\\“

Private Sub TextSpeichern(Ns As Outlook.NameSpace)

Set Ns = Application.GetNamespace(\“MAPI\“)
Set Items = Ns.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
SaveMailAsFile Item, olSaveAstxt, MAIL_PATH
End If
End Sub

Public Sub SaveMailAsFile(oMail As Outlook.MailItem, _
eType As olSaveAsTypeEnum, _
sPath As String _
)
Dim sName As String
Dim sExt As String

oMail.To = \“\“
oMail.Subject = \“\“

eType = olSaveAstxt: sExt = \“.txt\“

sName = \“versuch\“ & sExt

oMail.SaveAs sPath & sName, eType
End Sub

Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, \“/\“, sChr)
sName = Replace(sName, \“\\\“, sChr)
sName = Replace(sName, \“:\“, sChr)
sName = Replace(sName, \“?\“, sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, \“<\", sChr) sName = Replace(sName, \">\“, sChr)
sName = Replace(sName, \“|\“, sChr)
End Sub

Attachment abspeichern:
Code:

Public Sub AufnahmeMailVerschicken(objNewMail As MailItem)
Dim Ordnername As String
Dim objPosteingang As MAPIFolder
Dim anzahl
Dim i

On Error Resume Next
Set objPosteingang = Application.GetNamespace(\“MAPI\“).GetDefaultFolder(olFolderInbox)
For Each objNewMail In objPosteingang.Items
With objNewMail
If .UnRead = True Then
anzahl = .Attachments.Count
If anzahl > 0 Then
Ordnername = \“C:\\\“ & objNewMail.SenderName
MkDir Ordnername
For i = 1 To anzahl
.Attachments.Item(i).SaveAsFile Ordnername & \“\\\“ & .Attachments.Item(i).FileName
Next i
End If
End If
End With
Next objNewMail
End Sub

Danke schon im Voraus für eure Hilfe!

cyber.space