2
www.ChF-Online.de  

Mails flexibel speichern

   Neuigkeiten
   API-Aufrufe in VBA
   VBA2HTML
   Word
   Word-VBA
   Word2007 (RibbonX)
   Word2010 (RibbonX)
   Outlook-VBA
 Menüeinträge hinzufügen
aktiv aktiv Mails flexibel exportieren
   Links zu VB(A)
   DocToHelp
   Netport Express XL
   Astronomie
   Gästebuch
   Volltextsuche
   Sitemap
   Buch:Word-Programmierung
   Impressum & Kontakt
   Datenschutzerklärung
Getestet unter Outlook2000Getestet unter Win2000  
Beispiel anzeigen
Makro/Datei speichern
Print

Das folgende Beispiel soll aufzeigen, wie sich einzelnen Mails aus dem Eingangsordner speichern lassen. Dabei wird für den Dateinamen eine Kombination aus Absender und Betreff der Mail verwendet.

Die benötigten Informationen der markierten Mails werden aus den MailItem-Eigenschaften ausgelesen. Dazu werden nacheinander die MailItem-Objekte der markierten Mails mit ihren Eigenschaften an die Funktion fkt_Export weitergegeben, in der dann die Daten ausgewertet werden und daraus der Dateiname zusammengesetzt wird.

Public Sub ListSaveAs()  
' Definition der Variablen  
Dim myOLApp
Dim myInspector As Inspector
Dim myItem As MailItem
Dim myNameSpace As NameSpace
Dim myfolder As MAPIFolder
Dim myOlSel As Outlook.Selection
Dim myOlExp As Outlook.Explorer
Dim x As Integer 
' Mail-Eingangsordner festlegen  
Set myNameSpace = Outlook.GetNamespace("MAPI")
Set myfolder = myNameSpace.GetDefaultFolder(olFolderInbox)
' Markierter Eintrag  
On Error Resume Next 
' Ansicht auf Eingangsordner  
Set Application.ActiveExplorer.CurrentFolder = _
    myNameSpace.GetDefaultFolder(olFolderInbox)
Set myOlExp = Outlook.ActiveExplorer
' Markierte Mails zuweisen  
Set myOlSel = myOlExp.Selection
' Alle markierten Mails durchlaufen  
For x = 1 To myOlSel.Count
  Set myItem = myOlSel.Item(x)
  If myItem Is Nothing Then 
    MsgBox "Nichts markiert"
    Exit For 
  End If 
  On Error GoTo 0
    ' Exportieren  
    fkt_Export myItem
  Next x
' Aufräumen  
Set myItem = Nothing 
Set myOlExp = Nothing 
Set myOlSel = Nothing 
Set myfolder = Nothing 
Set myNameSpace = Nothing 
End Sub 

Die Funktion fkt_Export wertet die übergebenen MailItem-Objekte aus und setzt den Dateinamen, unter dem die Mail abgespeichert werden soll, aus dem Datum, dem Absendernamen und dem Betreff zusammen. Dabei werden alle Sonderzeichen im Betreff oder Absendernamen durch Leerzeichen ersetzt.

Function fkt_Export(ByRef myItem As MailItem)  
Dim datum, Pfad, absender, Betreff, dateiname, antwort, Zeit
Dim myuser As Object
Dim ret As String 
Dim antw As String 
Dim sDate As Date 
If myItem Is Nothing Then Exit Function 
datum = Format(myItem.SentOn, "dd.mm.yyyy")
' Festlegung des Datumsformats für den Dateinamen  
Zeit = Format(myItem.SentOn, "hh-mm-ss")
' Festlegung des Zeitformats für den Dateinamen  
absender = myItem.SenderName
' Auslesen der Empfangsdaten 
sDate = myItem.ReceivedTime
Set myuser = Application.GetNamespace("MAPI").CurrentUser
If absender = "" Then 
  ' Wenn keine Absendername vorhanden, dann Benutzernamen verwenden 
  absender = myuser
  datum = Format(Date, "dd.mm.yyyy")
  Zeit = Format(Time, "hh-mm-ss")
End If 
Betreff = myItem.Subject
Betreff = Replace(Betreff, ":", "_")
Betreff = Replace(Betreff, Chr$(34), "_")
Betreff = Replace(Betreff, "<", "_")
Betreff = Replace(Betreff, ">", "_")
Betreff = Replace(Betreff, "?", "_")
Betreff = Replace(Betreff, "/", "_")
Betreff = Replace(Betreff, "\", "_")
Betreff = Replace(Betreff, "*", "_")
dateiname = Pfad & absender & " - " & Betreff & " - " & datum & " " & Zeit
ret = fkt_FileSaveAs(dateiname)
If ret <> "" Then 
myItem.SaveAs ret, olMSG
antw = fkt_setTime(ret, sDate)
End If 

Beim Speichern der Mail wird als Dateidatum das Empfangsdatum verwendet, um besser sehen zu können, wann die jeweilige Mail erhalten wurde.
Diese Funktion verwendet zur Auswahl des Speicherortes das API  GetSaveFileName und zum Setzen des Empfangsdatum als Speicherdatum das API  SetFileTime.

Diese verschiedenen Angaben zur Darstellung des Dateinamens sollen an dieser Stelle nur Ideen für eigene Exportmöglichkeiten liefern und können mit diesen Informationen und dem Objektmodell leicht an eigene Bedürfnisse angepasst werden.


 Besucher: 2 online  |  24 heute  |  1363 diesen Monat  |  683094 insgesamt | Seitenaufrufe: 88   Letzte Änderung: 24.06.2006 © 2001-18 Christian Freßdorf
  Phantasie ist wichtiger als Wissen, denn Wissen ist begrenzt.
Albert Einstein
 powered by phpCMS and PAX