auswahl eines posfaches

Home-›Foren-›Outlook-›Outlook VBA-›auswahl eines posfaches

1 Antwort anzeigen (von insgesamt 1)
  • Autor
    Beitrag
  • #53127
    Unbekannt
    Teilnehmer

      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

    1 Antwort anzeigen (von insgesamt 1)

    -