StartDownloadsServiceBeispieleWorkshopsKontakt DeutschEnglish
 
Beispiele
Allgemein
Outlook®
 
Awarded by
Microsoft since 2005:
mvp logo
VBOffice Info
Besucher1826112
Aufrufe6849451
Links
Impressum
Datenschutz
Kontakt
E-Mail: Bei Empfang sofort im Dateisystem speichern
Autor: Michael BauerHomepage
Datum: 19.01.2006Zugriffe: 50785
  
Beschreibung

Das Beispiel speichert E-Mails, die in den Posteingang gelangen, als *.msg-Datei im Dateisystem. Als Dateiname werden die Empfangszeit und der Betreff genommen.

(Der Speicherpfad muss bereits vorhanden sein.)

Option Explicit

Public Enum olSaveAsTypeEnum
  olSaveAsTxt = 0
  olSaveAsRTF = 1
  olSaveAsMsg = 3
End Enum

Private WithEvents Items As Outlook.Items

Private Const MAIL_PATH As String = "d:\mails\"

Private Sub Application_Startup()
  Dim 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, olSaveAsMsg, MAIL_PATH
  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 sFile As String
  Dim sExt As String

  Select Case eType
    Case olSaveAsTxt: sExt = ".txt"
    Case olSaveAsMsg: sExt = ".msg"
    Case olSaveAsRTF: sExt = ".rtf"
    Case Else: Exit Sub
  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
 
 

ReplyAll warnt Sie, bevor Sie unbeabsichtigt allen Empfängern einer E-Mail antworten oder wenn Sie ein vertraulicher BCC-Empfänger der E-Mail ... [weiter]

 

Blitzschneller Zugriff auf die Hauptkategorienliste, gemeinsame Kategorien im Netzwerk, eine Erinnerungsfunktion ... [weiter]

 

SAM legt automatisch Absender, Signatur und Speicherort für gesendete Mails fest, z.B. anhand der ... [weiter]

 

OLKeeper verhindert zuverlässig, dass Mitarbeiter Outlook schließen und dadurch Termine oder E-Mails ... [weiter]

So entgeht Ihnen kein Auftrag mehr:
Telefonservice und Sekretariatsservice