EINZELNE (selektierte) Email als EML abspeichern

    This site uses cookies. By continuing to browse this site, you are agreeing to our Cookie Policy.

    • 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



      Source Code

      1. Private Sub ()
      2. par = Trim(Command$) ' Parametersatz bestehend aus MailItem-Pfad und einstelliger Ziffer (intern)
      3. Dim cItem, cFunktion As String
      4. If par <> "" Then
      5. cFunktion = Right(par, 1)
      6. cItem = Left(par, Len(par) - 2)
      7. Dim oApp As DvApi32.DavidAPI
      8. Dim oAccount As DvApi32.Account
      9. Dim oArchive As DvApi32.Archive
      10. Dim oMessageItems As DvApi32.MessageItems
      11. Dim oMsgItem As DvApi32.MessageItem
      12. Dim oMailItem As DvApi32.MailItem
      13. Dim oFaxItem As DvApi32.FaxItem
      14. Dim FileName As String
      15. Dim i As Integer
      16. Set oApp = CreateObject("DVOBJAPILib.DvISEAPI")
      17. Set oAccount = oApp.Logon("", "", "", "", "", "NOAUTH")
      18. Set oArchive = oAccount.GetArchive(Mid(cPfad, 1, InStrRev(cPfad, "\") - 1))
      19. Set oMsgItem = oArchive.GetArchiveEntryByID(cPfad)
      20. If oMsgItem.Type = 2 Then
      21. Set oMessageItems = oArchive.MailItems
      22. For i = 0 To oMessageItems.Count - 1
      23. If oMessageItems.Item(i).Type = 2 Then
      24. set oMailItem = oMessageItems.Item(i)
      25. If oMailItem._id = oMsgItem._id Then ' WIRD NICHT UNTERSTÜTZT
      26. FileName = Space(260)
      27. If DVEmlFromMailItem(oMailItem, FileName) <> 0 Then
      28. FileCopy FileName, "c:\" & oMailItem.Subject & ".eml"
      29. End If
      30. End If
      31. end if
      32. Next
      33. End If
      34. Set oMailItem = Nothing
      35. Set oMessageItems = Nothing
      36. Set oArchive = Nothing
      37. Set oApp = Nothing
      38. Else
      39. MsgBox ("FEHLER: Keine Parameter übergeben !")
      40. End If
      41. End Sub
      Display All

      The post was edited 3 times, last by Matze ().

    • Hallo Matze,

      das ist das Problem mit der API und VB...da der Unterstrich ja ein Zeilentrennzeichen ist (oder so).

      Schau Dir mal beim MailItem die Eigenschaft "TextSource" und beim MessageItem2 (Dein oMsgItem) den FullPath (über die Fields).
      Falls das nicht hinhaut arbeite auf beiden Seiten mit dem MessageItem2 und vergleiche den FullPath.

      Gruß Jens
      Es wäre schön, Deinen Vornamen zu kennen. Bitte beachte unsere Forenregeln und die Netiquette.

      ----------------------------------
      Jens Suing

      Tobit Software Authorized Partner *****
      Starface Advanced Partner
      work ... for all! Solution Partner
      bintec elmeg Certified Partner
      Kerio Partner
      ----------------------------------
      DIE Spezialisten - J.Suing
      www.schneller-und-besser.de
      DAS Portal: Faq, Forum
      ----------------------------------
      Support und Beratung unter
      02206-95100-0
      ----------------------------------
    • 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


      Source Code

      1. Private Declare Function DVEmlFromMailItem Lib "DvApi32" (ByVal oMailItem As DvApi32.MailItem, ByVal FileName As String) As Long
      2. Private Sub ()
      3. par = Trim(Command$)
      4. Dim cSuche, cFunktion
      5. If par <> "" Then
      6. cFunktion = Right(par, 1)
      7. cSuche = Left(par, Len(par) - 2)
      8. Dim oApp As DvApi32.DavidAPI
      9. Dim oAccount As DvApi32.Account
      10. Dim oArchive As DvApi32.Archive
      11. Dim oMessageItems As DvApi32.MessageItems
      12. Dim oMsgItem As DvApi32.MessageItem
      13. Dim oMailItem As DvApi32.MailItem
      14. Dim cID As String
      15. Dim i As Integer
      16. Set oApp = CreateObject("DVOBJAPILib.DvISEAPI")
      17. Set oAccount = oApp.Logon("", "", "", "", "", "NOAUTH")
      18. Set oArchive = oAccount.GetArchive(Mid(cSuche, 1, InStrRev(cSuche, "\") - 1))
      19. Set oMsgItem = oArchive.GetArchiveEntryByID(cSuche)
      20. If oMsgItem.Type = 2 Then ' Mail
      21. Set oMessageItems = oArchive.AllItems
      22. For i = 0 To oMessageItems.Count - 1
      23. If oMessageItems.Item(i).Type = 2 Then
      24. Set oMailItem = oMessageItems.Item(i)
      25. cID = oMailItem.TextSource
      26. cID = Left(cID, InStrRev(cID, ".") - 1)
      27. If cID = cSuche Then
      28. FileName = Space(260)
      29. If DVEmlFromMailItem(oMailItem, FileName) <> 0 Then
      30. FileCopy FileName, "c:\" & oMailItem.Subject & "_" & CStr(i) & ".eml"
      31. End If
      32. End If
      33. End If
      34. Next
      35. End If
      36. Set oMailItem = Nothing
      37. Set oMsgItem = Nothing
      38. Set oMessageItems = Nothing
      39. Set oArchive = Nothing
      40. Set oAccount = Nothing
      41. Set oApp = Nothing
      42. Else
      43. MsgBox ("FEHLER: Keine Parameter übergeben !")
      44. End If
      45. End Sub
      Display All
    • Hallo Matze,

      sorry, da kann ich Dir gerade auch nicht helfen.
      Aber geh das Ganze doch nochmal Schritt für Schritt durch, d.h. fang bei Deinem hier eingangs geposteten Code an und mach dann nochmal alle Änderungen bez. der TextSource Geschichte.

      Gruß Jens

      PS: Mir ist noch was eingefallen. TextSource funktioniert erst ab fx oder fx2011 soweit ich weiß, also aufpassen bei älteren David Versionen.
      Es wäre schön, Deinen Vornamen zu kennen. Bitte beachte unsere Forenregeln und die Netiquette.

      ----------------------------------
      Jens Suing

      Tobit Software Authorized Partner *****
      Starface Advanced Partner
      work ... for all! Solution Partner
      bintec elmeg Certified Partner
      Kerio Partner
      ----------------------------------
      DIE Spezialisten - J.Suing
      www.schneller-und-besser.de
      DAS Portal: Faq, Forum
      ----------------------------------
      Support und Beratung unter
      02206-95100-0
      ----------------------------------