EINZELNE (selektierte) Email als EML abspeichern

Hallo allerseits

Ich plage mich seit Stunden mit einem scheinbar banalen Problem herum und stehe regelrecht auf dem Schlauch. Also bitte nicht böse sein, wenn die Lösung scheinbar so einfach ist, daß ich den Wald vor lauter Bäumen nicht sehe. Im Forum konnte ich hierzu allerdings nichts konkretes finden.

Das Problem: Ich möchte die aktuell selektierte Email als EML im Filesystem abspeichern. Das Skriptbeispiel ("Save MailItem as *.eml file", in VBA) habe ich bereits erfolgreich umgesetzt, allerdings möchte ich gezielt nur EINE Email abspeichern. Mein Vorgänger hat dieses in Visual FoxPro programmiert und es so gelöst: Nachdem das Messageitem über GetArchiveEntryByID ermittelt wurde, werden alle Mailitems durchlaufen, bis das korrekte Item per ID-Vergleich gefunden wurde. Dieses Mailitem wird dann per DVEmlFromMailItem im EML-Formart abgespeichert.

In meinem Skript habe ich keine Möglichkeit, die Message-ID mit der Mail-ID zu vergleichen, denn die Property "._id" (get__ID) wird schlichtweg nicht unterstützt (Zeile 29). Was habe ich vergessen/übersehen oder welche andere Möglichkeit gibt es, zu einem MessageItem das MailItem zu ermitteln ?

Vielen Dank im voraus für Eure Hilfe
Matze

Private Sub () par = Trim(Command$) ' Parametersatz bestehend aus MailItem-Pfad und einstelliger Ziffer (intern) Dim cItem, cFunktion As String If par <> "" Then  cFunktion = Right(par, 1)  cItem = Left(par, Len(par) - 2)  Dim oApp As DvApi32.DavidAPI  Dim oAccount As DvApi32.Account  Dim oArchive As DvApi32.Archive  Dim oMessageItems As DvApi32.MessageItems  Dim oMsgItem As DvApi32.MessageItem  Dim oMailItem As DvApi32.MailItem  Dim oFaxItem As DvApi32.FaxItem  Dim FileName As String  Dim i As Integer  Set oApp = CreateObject("DVOBJAPILib.DvISEAPI")  Set oAccount = oApp.Logon("", "", "", "", "", "NOAUTH")  Set oArchive = oAccount.GetArchive(Mid(cPfad, 1, InStrRev(cPfad, "\") - 1))  Set oMsgItem = oArchive.GetArchiveEntryByID(cPfad)  If oMsgItem.Type = 2 Then   Set oMessageItems = oArchive.MailItems   For i = 0 To oMessageItems.Count - 1    If oMessageItems.Item(i).Type = 2 Then     set oMailItem = oMessageItems.Item(i)     If oMailItem._id = oMsgItem._id Then ' WIRD NICHT UNTERSTÜTZT      FileName = Space(260)      If DVEmlFromMailItem(oMailItem, FileName) <> 0 Then       FileCopy FileName, "c:\" & oMailItem.Subject & ".eml"      End If     End If    end if   Next  End If  Set oMailItem = Nothing  Set oMessageItems = Nothing  Set oArchive = Nothing  Set oApp = Nothing Else  MsgBox ("FEHLER: Keine Parameter übergeben !") End If End Sub

Hallo Jens,

ich bin am verzweifeln...
Erstmal vielen lieben Dank für Deine Hilfe ! Mithilfe der "TextSource"-Property hat es tatsächlich geklappt; diese brauche ich (ohne Datei-Extension) nur mit meinem cItem vergleichen (welches mit %s aus dem David-Prozeduraufruf übergeben wird). Damit habe ich die gewünschte Email lokalisiert.

Nun habe ich allerdings das Problem, daß die Funktion "DVEmlFromMailItem" nicht (mehr) funktioniert. Sie liefert zwar den Rückgabewert "1", gibt jedoch keinen Dateinamen zurück, der Leerstring bleibt unverändert; es scheint so, daß die temporäre Datei nicht erzeugt werden kann. Das hat gestern noch wunderbar funktioniert und ich bin mir keiner Änderung bewusst, die irgendeinen Einfluss darauf haben könnte. Hast Du eine Idee, woran das liegen könnte ?

Ganz herzlichen Dank im voraus
Matze

Private Declare Function DVEmlFromMailItem Lib "DvApi32" (ByVal oMailItem As DvApi32.MailItem, ByVal FileName As String) As Long
Private Sub ()
par = Trim(Command$)
Dim cSuche, cFunktion


If par <> "" Then
    cFunktion = Right(par, 1)
    cSuche = Left(par, Len(par) - 2) 


    Dim oApp As DvApi32.DavidAPI
    Dim oAccount As DvApi32.Account
    Dim oArchive As DvApi32.Archive
    Dim oMessageItems As DvApi32.MessageItems
    Dim oMsgItem As DvApi32.MessageItem
    Dim oMailItem As DvApi32.MailItem
    Dim cID As String
    Dim i As Integer

    Set oApp = CreateObject("DVOBJAPILib.DvISEAPI")
    Set oAccount = oApp.Logon("", "", "", "", "", "NOAUTH")
    Set oArchive = oAccount.GetArchive(Mid(cSuche, 1, InStrRev(cSuche, "\") - 1))
    Set oMsgItem = oArchive.GetArchiveEntryByID(cSuche)
    If oMsgItem.Type = 2 Then   ' Mail
        Set oMessageItems = oArchive.AllItems
        For i = 0 To oMessageItems.Count - 1
            If oMessageItems.Item(i).Type = 2 Then
                Set oMailItem = oMessageItems.Item(i)
                cID = oMailItem.TextSource
                cID = Left(cID, InStrRev(cID, ".") - 1)
 
                If cID = cSuche Then
                    FileName = Space(260)
                    If DVEmlFromMailItem(oMailItem, FileName) <> 0 Then
                        FileCopy FileName, "c:\" & oMailItem.Subject & "_" & CStr(i) & ".eml"
                    End If
                End If
            End If
        Next

    End If
    Set oMailItem = Nothing
    Set oMsgItem = Nothing
    Set oMessageItems = Nothing
    Set oArchive = Nothing
    Set oAccount = Nothing
    Set oApp = Nothing


Else


    MsgBox ("FEHLER: Keine Parameter übergeben !")


End If




End Sub