E-Mails von einem Microsoft Exchange Server abholen und Dateianhänge auspacken (im Dateisystem speichern): Codebeispiel für Visual Basic .NET (VB.NET)

Code-Beispiel

E-Mails von einem Microsoft Exchange Server abholen und Dateianhänge auspacken (im Dateisystem speichern)

Beschreibung

Der Code verwendet CDO (Collaboration Data Object), eine COM-Komponente. Die CDO-Komponente ist in Form eines Wrappers (Namensraum Interop.Mapi) einzubinden.

Programmcodebeispiele Visual Basic .NET (VB.NET)


    ' E-Mails von einem Microsoft Exchange Server abholen und Dateianhänge auspacken (im Dateisystem speichern)

' (C) Dr. Holger Schwichtenberg 2007



Imports Interop

Imports System



Module MainModule

 Dim Ergebnis As String = ""

 Dim Anzahl As Long = 0

 Const PROFILNAME As String = "Agent"

 Const ORDNERNAME As String = "Datenordner"

 Const DATEISYSTEM As String = "d:\daten"



 Sub Main()

  AttachmentsAuswerten()

  Console.ReadLine()

 End Sub



 Sub OutDebug(ByVal s As String)

  Dim sw As New System.IO.StreamWriter("C:\log.txt", True)

  sw.WriteLine(DateTime.Now + ": " + s)

  sw.Close()

  Console.WriteLine(s)

 End Sub



 Sub AttachmentsAuswerten()

  OutDebug("Starte Abholvorgang...")

  'Try

  Dim objSession As mapi.Session

  Dim objF1 As mapi.Folder

  Dim objF2 As mapi.Folder

  ' --- Instanziierung mit new !

  objSession = New mapi.Session()

  ' --- Anmelden

  OutDebug("Login")

  ' Statisches Profil

  objSession.Logon(PROFILNAME)

  ' Dynamicshes Profil

  Dim strProfileInfo As String = "192.168.1.191" & vbLf & "HS"

  'objSession.Logon("", "", False, True, 0, False, strProfileInfo)



  ' --- Zugriff auf Ordner

  objF1 = CType(objSession.Inbox, mapi.Folder)

  objF2 = recsearch_Folder(objF1, ORDNERNAME)

  ' --- Nachrichten auswerten

  For Each m As mapi.Message In objF2.Messages

   If m.Unread Then

    For Each a As mapi.Attachment In m.Attachments

     Ergebnis &= a.Name & ";"

     Anzahl += 1

     a.WriteToFile(DATEISYSTEM & a.Name)

     OutDebug("Anhang: " & a.Name)

    Next

   End If

  Next

  OutDebug("Fertig: Anzahl der Anhänge: " & Anzahl)

  OutDebug("Abholvorgang beendet!")

  'Catch ex As Exception

  ' OutDebug("Fehler: " & ex.GetType().FullName & ":" + ex.Message)

  ' 'End Try

 End Sub





 Public Function recsearch_Folder(ByVal objStartFO, ByVal OrdnerName)

  Dim objF As mapi.Folder

  If Not objStartFO Is Nothing Then

   ' --- Vergleich ausführen

   If objStartFO.Name = OrdnerName Then

    Return objStartFO

   Else

    ' --- Rekursion über alle Unterordner

    For Each objF In objStartFO.Folders

     Dim objF2 As mapi.Folder = recsearch_Folder(objF, OrdnerName)

     ' --- Abbruchbedigung der Rekursion

     If objF2 IsNot Nothing Then Return objF2

    Next

    Return Nothing

   End If

  End If

  Return Nothing

 End Function

End Module