vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Erstellen von dynamischen Kontextmen?s - wann immer Sie sie brauchen!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: HTML/Internet/Netzwerk · HTML/Email   |   VB-Versionen: VBA, VB2005, VB200821.05.10
Export von Outlook-Emails (ausgewählte Daten) in eine Textdatei

Eine Funktion zum Exportieren ausgewählter Daten von Outlook-Emails aus einem wählbaren Folder. VB.net- und VBA-Code.

Autor:   Dietrich HerrmannBewertung:     [ Jetzt bewerten ]Views:  16.510 
ohne HomepageSystem:  Win2k, WinXP, Win7, Win8, Win10, Win11kein Beispielprojekt 

Ich musste bestimmte Emaildaten in SQL-Datenbank importieren. Dabei hat sich gezeigt, dass es wohl am Besten wäre, eine eigene Funktion für den Export der Daten in eine Textdatei zu schreiben. Das Problem beim Export von Emails ist u.a., dass für die Verwendung in SQL-Text-Datenfeld die in Subject oder Body enthaltenen Zeilenschaltungen und Tabulatoren erst mal "verschwinden" müssen (ersetze sie mit bestimmten Zeichen, die man sich aber selbst auswählen kann). Im unten stehenden Code mache ich das mit den Replacements. Das kann man dann später an der Datentabelle zurückändern.

Die Ausgabedatei muss inkl. Pfad und Name angegeben werden ("c:\temp\outlookitems.txt").

Es wird keine Headerzeile mit den Feldnamen ausgegeben.

Ich stelle hier erstens den VB.net-Code vor und in der zweiten Variante den Code als VBA-Makro.

1.VB.net:

Imports System.IO, System.Text
Imports Microsoft.Office.Interop
Imports Microsoft.Office.Interop.Outlook
''' <summary>
''' Exportieren von Emaildaten in eine Textdatei
''' </summary>
''' <param name="FileWithPath">Dateiname inkl. Pfad für die Ausgabe-Textdatei</param>
''' <param name="delim">das Delimiter-Zeichen für die Trennung der Datenfelder</param>
''' <returns>Anzahl der geschriebenen MailItems</returns>
Public Function ExportMailToText(ByVal FileWithPath As String, _
  Optional ByVal delim As String = Chr(9)) As Integer
 
  Dim Zeile As String
  Dim olAppl As Outlook.Application
  Dim nms As Outlook.NameSpace
  Dim fld As Outlook.MAPIFolder
  Dim msg As Outlook.MailItem
  Dim zz As Integer
 
  Dim fs = CreateObject("Scripting.FileSystemObject")
  Dim Exp = fs.CreateTextFile(FileWithPath, True)
 
  ' Verweis auf Outlook
  olAppl = CreateObject("Outlook.Application")
  ' Verweis auf "MAPI"
  nms = olAppl.GetNamespace("MAPI")
 
  ' Select Outlookfolder für den Export
  fld = nms.PickFolder
  If IsNothing(fld) OrElse fld.Items.Count = 0 Then Return Nothing
 
  ' Schreiben der Itemdaten in Textdatei
  For i = 1 To fld.Items.Count
    Zeile = ""
    msg = fld.Items(i)
    With msg
      Zeile += Replace(.Subject, Chr(9), "*") + delim
      Zeile += Replace(Replace(Replace(.Body, Chr(10), ""), Chr(9), "*"), _
        Chr(13), "#") + delim
      Zeile += .SenderName + delim
      Zeile += .SenderEmailAddress + delim
      Zeile += .ReceivedByName + delim
      Zeile += .To + delim
      Zeile += CStr(.SentOn) + delim
      Zeile += CStr(.ReceivedTime)
    End With
    On Error Resume Next
    Exp.WriteLine(Zeile)
    zz += 1
  Next i
  Exp.Close()
  Return zz
End Function

2. VBA-Makro
Das Makro einfach in Outlook mittels VB-Editor einspeichern und ausführen.

' Exportieren von Emaildaten in eine Textdatei
Sub ExportMailToText()
  Dim FileWithPath, Zeile, delim As String
  Dim nms As Outlook.NameSpace
  Dim fld As Outlook.MAPIFolder
  Dim msg As Outlook.MailItem
 
  delim = Chr(9)
  FileWithPath = "C:\Temp\OutlookItems.txt"
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set a = fs.CreateTextFile(FileWithPath, True)
 
  ' Select Outlookfolder für den Export
  Set nms = Application.GetNamespace("MAPI")
  Set fld = nms.PickFolder
  If fld Is Nothing Then Exit Sub
  If fld.Items.Count = 0 Then Exit Sub
 
  ' Schreiben der Itemdaten in Textdatei
  For i = 1 To fld.Items.Count
    Zeile = ""
    Set msg = fld.Items(i)
    With msg
      Zeile = Zeile + Replace(.Subject, Chr(9), "*") + delim
      Zeile = Zeile + Replace(Replace(.Body, Chr(9), "*"), Chr(13), "#") + delim
      Zeile = Zeile + Replace(Replace(.Body, Chr(10), "#"), Chr(12), "#") + delim
      Zeile = Zeile + .SenderName + delim
      Zeile = Zeile + .SenderEmailAddress + delim
      Zeile = Zeile + .ReceivedByName + delim
      Zeile = Zeile + .To + delim
      Zeile = Zeile + Str(.SentOn) + delim
      Zeile = Zeile + Str(.ReceivedTime)
    End With
    On Error Resume Next
    a.WriteLine Zeile
  Next i
  a.Close
End Sub

Happy exporting