Zum Inhalt springen

Mail-Anhang abspeichern und Body-Text als txt abspeichern


Empfohlene Beiträge

Geschrieben

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

Geschrieben

Versuche erst mal ein Teil des Quellcodes zum Laufen zu bekommen und danach den anderen. Erst wenn beide Teile eigenständig laufen, kannst du versuchen diese aneinander zufügen.

Erstelle ein Benutzerkonto oder melde Dich an, um zu kommentieren

Du musst ein Benutzerkonto haben, um einen Kommentar verfassen zu können

Benutzerkonto erstellen

Neues Benutzerkonto für unsere Community erstellen. Es ist einfach!

Neues Benutzerkonto erstellen

Anmelden

Du hast bereits ein Benutzerkonto? Melde Dich hier an.

Jetzt anmelden

Fachinformatiker.de, 2024 by SE Internet Services

fidelogo_small.png

Schicke uns eine Nachricht!

Fachinformatiker.de ist die größte IT-Community
rund um Ausbildung, Job, Weiterbildung für IT-Fachkräfte.

Fachinformatiker.de App

Download on the App Store
Get it on Google Play

Kontakt

Hier werben?
Oder sende eine E-Mail an

Social media u. feeds

Jobboard für Fachinformatiker und IT-Fachkräfte

×
×
  • Neu erstellen...