Überblick
- Status
- Offen
- Forum
- Outlook VBA
- Gefragt von
- Unbekannt
- Gefragt am
- Antworten
- 0
Frage
fragte am
Hallo zusammen,
Ich würde eure fachkundige Unterstützung benötigen da ich selbst schon fast am verzweifeln bin. Ich verwende ein Makro welches ankommende und abgehende Mails automatisch als .txt Datei abspeichert – funkt auch wunderbar.
Ich verwalte in Outlook 2 Konten (Hotmail) und leider greift das Makro nur auf den default Posteingang zu. Wie schaffe ich es das ich das zweite (nur das zweite!) Konto überwache?! Es handelt sich um ein Hotmailkonto – Bezeichnung „Thomas“ sollte das wichtig sein…
Public Enum olSaveAsTypeEnum
olSaveAsTxt = 0
olSaveAsRTF = 1
olSaveAsMsg = 3
End Enum
Private WithEvents outgoingItems As Outlook.Items
Private WithEvents incomingItems As Outlook.Items
Private Const incomingPfad As String = \“P:\\temp\\IncomingMails\\\“
Private Const outgoingPfad As String = \“P:\\temp\\OutgoingMails\\\“
Private Sub Application_Startup()
Dim Ns As Outlook.NameSpace
Set Ns = Application.GetNamespace(\“MAPI\“)
Set incomingItems = Ns.GetDefaultFolder(olFolderInbox).Items
Set outgoingItems = Ns.GetDefaultFolder(olFolderSentMail).Items
End Sub
Private Sub incomingItems_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
SaveMailAsFile Item, olSaveAsTxt, incomingPfad
End If
End Sub
Private Sub outgoingItems_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
SaveMailAsFile Item, olSaveAsTxt, outgoingPfad
End If
End Sub
Private Sub SaveMailAsFile(oMail As Outlook.MailItem, eType As olSaveAsTypeEnum, sPath As String)
Dim dtDate As Date
Dim sName As String
Dim sExt As String
Select Case eType
Case olSaveAsTxt: sExt = \“.txt\“
Case olSaveAsMsg: sExt = \“.msg\“
Case olSaveAsRTF: sExt = \“.rtf\“
End Select
sName = oMail.Subject
ReplaceCharsForFileName sName, \“_\“
dtDate = oMail.ReceivedTime
sName = Format(dtDate, \“yyyymmdd\“, vbUseSystemDayOfWeek, vbUseSystem) & Format(dtDate, \“-hhnnss\“, vbUseSystemDayOfWeek, vbUseSystem) & \“-\“ & sName & 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
Noch keine Antworten
Zu dieser Frage gibt es noch keine Antwort. Wissen Sie weiter? Dann helfen Sie mit Ihrer Antwort unten.
- Sie müssen angemeldet sein, um zu diesem Thema eine Antwort verfassen zu können.
