[Gelöst]Erstellen und versenden von EMails über die dvapi32 mit Vorlagen und Latebinding in VBA

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

    • [Gelöst]Erstellen und versenden von EMails über die dvapi32 mit Vorlagen und Latebinding in VBA

      Hallo an alle,

      ich habe die Aufgabe bekommen eine Schnittstelle zwischen David und unseren Programm zu schreiben. Die Schnittstelle ist auch soweit fertig, nur gibt es noch ein paar kleine Probleme.

      Hier erst mal die Grundinfos:
      Programmiersprache: VBA (Access)
      DVAPI32: 12.00a 0437
      Latebinding: JA


      Source Code

      1. Public Function EMail_VersendenTobit(EMailAdresse, BetreffTxt As String, EMailText As String, Optional SofortSendenOderAnzeigen As Integer, Optional davidAppl, Optional AttachmentsPathsLöschen As Boolean) As Boolean
      2. On Error GoTo Err_End1
      3. '*** für das Verständnis noch die dvapi32 Typen ***
      4. 'Dim obj_App As DvApi32.IApplication
      5. 'Dim obj_Account As DvApi32.Account
      6. 'Dim obj_Archive As DvApi32.Archive
      7. 'Dim obj_MailItem As DvApi32.MessageItem2
      8. 'Dim oAttachment As DvApi32.Attachment
      9. Dim I As Integer
      10. Dim obj_App As Object
      11. Dim obj_Account As Object
      12. Dim obj_Archive As Object
      13. Dim obj_MailItem As Object
      14. Dim str_RecNo As String
      15. Dim obj_WshShell As Object
      16. Dim str_ShellCmd As String
      17. Dim str_TobitPath As String
      18. Dim str_TobitSvr As String
      19. Dim str_Template As String
      20. Dim str_Templatefn As String
      21. '*** erstellen der Objekte ***
      22. Set obj_App = CreateObject("DVOBJAPILib.DvISEAPI")
      23. Set obj_Account = obj_App.Logon("", "", "", "", "", "AUTH")
      24. Set obj_Archive = obj_Account.GetSpecialArchive(102) 'Konstante "102" gibt Ausgangsarchiv an!
      25. Set obj_MailItem = obj_Archive.CreateArchiveEntry(2) 'Konstante "2" steht für Email!
      26. '*** Tobit Servername auslesen ***
      27. str_TobitSvr = obj_Account.ServerName
      28. '*** Vorlagenverzeichnis einlesen ***
      29. Set obj_WshShell = CreateObject("WScript.Shell")
      30. str_ShellCmd = "HKCU\Software\Tobit\Tobit InfoCenter\Servers\" & str_TobitSvr & "\TemplateFN"
      31. str_Template = obj_WshShell.RegRead(str_ShellCmd)
      32. str_Templatefn = Right(str_Template, (Len(str_Template) - InStrRev(str_Template, "\")))
      33. '*** Erststellen der Email ***
      34. With obj_MailItem
      35. .Fields("SRTo").Value = FNz(EMailAdresse, "")
      36. '*** CC und BCC benötigen 2 dimensionale Arrays als Übergabe! ***
      37. ' .Fields("Cc").Value = FNz(EMailAdresse_CC, "")
      38. ' .Fields("BCc").Value = FNz(EMailAdresse_BCC, "")
      39. .Subject = ""
      40. .Fields("CONTENT").Value = FNz(EMailText, "")
      41. .Fields("Subject").Value = FNz(BetreffTxt, "")
      42. .Fields("Priority").Value = 0
      43. '.Fields("SourceFileName").Value = str_Template
      44. End With
      45. If SofortSendenOderAnzeigen = 0 Then
      46. obj_MailItem.Save
      47. '*** RecNo = ID der erstellten Email! ***
      48. str_RecNo = obj_MailItem.Fields("RecNo").Value
      49. '*** öffnen der Email in Tobit ***
      50. str_ShellCmd = str_TobitPath & "\DVWIN32.EXE " & obj_Archive.ID & " /SA=34 /POS=" & str_RecNo & " /FROM=" & str_Template
      51. obj_WshShell.Exec (str_ShellCmd)
      52. '*** Wichtig!!! Löschen des Emailobjekts! Sonst ist Email doppelt vorhanden! ***
      53. obj_MailItem.Delete
      54. Else
      55. '*** normales Senden der Email ***
      56. obj_MailItem.Send
      57. Set obj_MailItem = Nothing
      58. End If
      59. Exit_End1:
      60. Exit Function
      61. Err_End1:
      62. Select Case ErrorHandler(""): Case Is = 5: Resume Next: Case Is = 4: Resume: End Select: Resume Exit_End1
      63. Resume
      64. End Function
      Display All
      Bitte nicht wundern. Ich habe einige interne Passagen raus genommen, da Sie für die Probleme unwichtig sind.

      Hier nun meine Probleme:

      1. Ich würde gern das Programm mit einer Vorlage öffnen und versenden, leider fehlen mir die Befehle um diese in das Mailitem einzufügen.

      2. Das sofort senden funktioniert nicht da in David angezeigt wird das keine Email-Adresse vorhanden ist. (Meine Vermutung: .send greift nicht auf die .fields("SRTo") zu.)

      Ich hoffe ihr könnt mir helfen.


      Gruß

      Axel

      The post was edited 1 time, last by VNV_Nightmare ().

    • Hallo an alle,

      nachdem ich nun die Zeit gefunden habe mich mit dem Problem intensiv zu beschäftigen folgt nun die Lösung meiner Probleme:

      zu 1) Hier muss nur der HTML body und HTML displaybody aus der Vorlage ausgelesen werden (Nicht vergessen die Umlaute umzuwandeln in HTML). Wichtig ist das beim latebinding die Variablen mit einem "Trim" versehen werden, denn aus einen unersichtlichen Grund kommt die DLL mit dem Leerzeichen im latebinding nicht klar. Unten folgt der Code.

      zu 2) Es ist so wie ich es vermutet habe. .send greift nicht auf die .fields("SRTo") zu. Sondern nur auf .fields("To") welches ein 2 dimensionales Array benötigt. Auch das ist im Code zu ersehen.


      Source Code

      1. Public Function EMail_VersendenTobit(EMailAdresse, BetreffTxt As String, EMailText As String, AttachmentsPaths() As String, Optional SofortSendenOderAnzeigen As Integer, Optional davidAppl, Optional AttachmentsPathsLöschen As Boolean) As Boolean
      2. On Error GoTo Err_End1
      3. '*** Zum Verständnis die Tobit Variablen ***
      4. 'Dim obj_App As DvApi32.IApplication
      5. 'Dim obj_Account As DvApi32.Account
      6. 'Dim obj_Archive As DvApi32.Archive
      7. 'Dim obj_MailItem As DvApi32.MessageItem2
      8. 'Dim obj_TemplateArchiv As DvApi32.Archive
      9. 'Dim obj_TemplateMItem As DvApi32.MessageItem2
      10. Dim I As Integer
      11. Dim obj_App As Object
      12. Dim obj_Account As Object
      13. Dim obj_Archive As Object
      14. Dim obj_MailItem As Object
      15. Dim obj_TemplateArchiv As Object
      16. Dim obj_TemplateMItem As Object
      17. Dim str_RecNo As String
      18. Dim obj_WshShell As Object
      19. Dim str_ShellCmd As String
      20. Dim str_TobitPath As String
      21. Dim str_TobitSvr As String
      22. Dim str_TemplateFile As String
      23. Dim arr_Empfaenger(0, 1) As String
      24. '*** erstellen der Objekte ***
      25. Set obj_App = CreateObject("DVOBJAPILib.DvISEAPI")
      26. Set obj_Account = obj_App.Logon("", "", "", "", "", "AUTH")
      27. Set obj_Archive = obj_Account.GetSpecialArchive(102) 'Konstante "102" gibt Ausgangsarchiv an!
      28. Set obj_MailItem = obj_Archive.CreateArchiveEntry(2) 'Konstante "2" steht für Email!
      29. '*** Tobit Servername auslesen ***
      30. str_TobitSvr = obj_Account.ServerName
      31. '*** Vorlagenverzeichnis einlesen ***
      32. Set obj_WshShell = CreateObject("WScript.Shell")
      33. str_ShellCmd = "HKCU\Software\Tobit\Tobit InfoCenter\Servers\" & str_TobitSvr & "\TemplateFN"
      34. str_TemplateFile = obj_WshShell.RegRead(str_ShellCmd)
      35. Set obj_TemplateArchiv = obj_Account.GetSpecialArchive(10) 'Konstante "10" gibt TemplateOrdner an!
      36. Set obj_TemplateMItem = obj_TemplateArchiv.GetArchiveEntryByID(Trim(str_TemplateFile))
      37. '*** Erststellen der Email ***
      38. With obj_MailItem
      39. arr_Empfaenger(0, 0) = EMailAdresse
      40. arr_Empfaenger(0, 1) = EMailAdresse
      41. .Fields("To").Value = arr_Empfaenger
      42. '*** CC und BCC benötigen 2 dimensionale Arrays als Übergabe! ***
      43. ' .Fields("Cc").Value = FNz(EMailAdresse_CC, "")
      44. ' .Fields("BCc").Value = FNz(EMailAdresse_BCC, "")
      45. .Fields("HTML").Value = TobitFixUmlaute(obj_TemplateMItem.Fields("HTML").Value) 'FNz(EMailText, "")
      46. .Fields("HTMLDisplayContent").Value = TobitFixUmlaute(obj_TemplateMItem.Fields("HTMLDisplayContent").Value) 'FNz(EMailText, "")
      47. .Fields("Subject").Value = FNz(BetreffTxt, "")
      48. .Fields("Priority").Value = 0
      49. For I = 0 To UBound(AttachmentsPaths, 1)
      50. If AttachmentsPaths(I) <> "" Then
      51. If fs.FileExists(AttachmentsPaths(I)) Then
      52. .Attachments.Add (AttachmentsPaths(I))
      53. End If
      54. End If
      55. Next I
      56. End With
      57. If SofortSendenOderAnzeigen = 0 Then
      58. obj_MailItem.Save
      59. '*** RecNo = ID der erstellten Email! ***
      60. str_RecNo = obj_MailItem.Fields("RecNo").Value 'obj_TemplateMItem.Fields("RecNo").Value
      61. '*** öffnen der Email in Tobit ***
      62. str_ShellCmd = str_TobitPath & "\DVWIN32.EXE " & obj_Archive.ID & " /SA=34 /POS=" & str_RecNo
      63. obj_WshShell.Exec (str_ShellCmd)
      64. '*** Wichtig!!! Löschen des Emailobjekts! Sonst ist Email doppelt vorhanden! ***
      65. obj_MailItem.Delete
      66. Else
      67. '*** normales Senden der Email ***
      68. obj_MailItem.Send
      69. Set obj_MailItem = Nothing
      70. End If
      71. EMail_VersendenTobit = True
      72. Exit_End1:
      73. Exit Function
      74. Err_End1:
      75. Select Case ErrorHandler(""): Case Is = 5: Resume Next: Case Is = 4: Resume: End Select: Resume Exit_End1
      76. Resume
      77. End Function
      Display All

      Ich hoffe ich konnte damit Leuten weiterhelfen die das selbe Problem haben.

      Grüße

      Axel