Home-›Foren-›Outlook-›Outlook VBA-›Mail-Anhang abspeichern und Body-Text als txt abspeichern
- Dieses Thema hat 4 Antworten sowie 1 Stimme und wurde zuletzt vor 19:25 um 6. Juli 2010 von Unbekannt aktualisiert.
- AutorBeitrag
- 7. Mai 2010 um 17:10 #51694UnbekanntTeilnehmer
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 EnumPrivate 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 SubPrivate Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
SaveMailAsFile Item, olSaveAstxt, MAIL_PATH
End If
End SubPublic Sub SaveMailAsFile(oMail As Outlook.MailItem, _
eType As olSaveAsTypeEnum, _
sPath As String _
)
Dim sName As String
Dim sExt As StringoMail.To = \”\”
oMail.Subject = \”\”eType = olSaveAstxt: sExt = \”.txt\”
sName = \”versuch\” & sExt
oMail.SaveAs sPath & sName, eType
End SubPrivate 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 SubAttachment abspeichern:
Code:Public Sub AufnahmeMailVerschicken(objNewMail As MailItem)
Dim Ordnername As String
Dim objPosteingang As MAPIFolder
Dim anzahl
Dim iOn 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 SubDanke schon im Voraus für eure Hilfe!
cyber.space
27. Juni 2010 um 13:04 #181082UnbekanntTeilnehmerMoin
Versuch`s mal so:
Sub test(Item As Outlook.MailItem)
Dim F As Integer
anzahl = Item.Attachments.Count
If anzahl > 0 Then Else Exit Sub \’ nur wenn Anhang dran
Ordnername = \”C:\\test\”
\’ nimmt ersten Anhang, sonst müsste mann eine Schleife einbauen
Item.Attachments.Item(1).SaveAsFile Ordnername & \”\\\” & Item.Attachments.Item(1).FileName
Text = Item.Body
sFilename = \”C:\\test.txt\”\’ Datei zum Schreiben öffnen
\’ Achtung: bisheriger Inhalt wird gelöscht!
F = FreeFile
Open sFilename For Output As #F
Print #F, Text
Close #F
End SubDiese sub in ThisOutlookSession rein
Regel : bei Ankunft Skript ausführenHabs nicht getestet
mfg
Thomas4. Juli 2010 um 19:18 #181213UnbekanntTeilnehmerHallo!
Danke Thomas! Das Skript funktioniert schon sehr gut! Nur habe ich in dieser Mail 3 Bilder und 1 Mp3-file drinnen. Effektiv wird aber nur ein Bild und kein mp3-file abgespeichert. Habt ihr dafür eine Erklärung?
Es wär echt super, wenn ich das Problem noch lösen könnte!
mfg
cyber.space
5. Juli 2010 um 00:18 #181219UnbekanntTeilnehmerHallo!
Mein Problem hat sich erledigt. Ich habe eine Schleife hineingebaut.
Danke für die Hilfe!!!
mfg
cyber.space
6. Juli 2010 um 19:25 #181259UnbekanntTeilnehmer… wenn Du genug hast vom Programmieren.
- AutorBeitrag