Zum Inhalt springen
Hilfe zu Outlook, Thunderbird, KuNoMail & Co.

auswahl eines posfaches

Überblick

Status
Offen
Gefragt von
Unbekannt
Gefragt am
Antworten
0

Frage

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.