Neue E-Mail via API erstellen und öffnen

Public Sub SendNewMail(ByVal mTobitServer As String, _
                   	ByVal mTobitAccoutname As String, _
                   	ByVal mTobitPasswort As String, _
                   	ByVal mEmpfaenger As String, _
                   	ByVal mBetreff As String, _
                   	ByVal mBody As String, _
                   	Optional ByVal mAttachments As Collection)


  	
   Dim Success As Boolean
   Dim TobitMailItem As DvApi32.MailItem
   Dim TobitMessageItem2 As DvApi32.MessageItem2
   Dim TobitMessageItems2 As DvApi32.MessageItems2
   Dim i As Integer
   Dim AnhangMsg As String
   Dim TobitProgname As String
   Dim RegistryOBJ As RegistryCLS
   Dim RegSettingOBJ As RegSettingCLS
   Dim ShellStr As String
   Dim TobitArchive As DvApi32.Archive

   'Logon am David-Server durchführen
   Success = DoTobitLogon(mTobitServer, mTobitAccoutname, mTobitPasswort)

   If Success Then
  	Set TobitArchive = myTobitAccount.GetSpecialArchive(DvArchivePersonalOut)
  	Set TobitMailItem = TobitArchive.NewItem(DvEMailItem)
  	TobitMailItem.Options.UserHold = True

  	With TobitMailItem
     	If Not mAttachments Is Nothing Then
        	AnhangMsg = "Anhang" 'Anhang
        	For i = 1 To mAttachments.Count
Call .Attachments.Add(mAttachments.Item(i), AnhangMsg & "_" & CStr(i))
              	Call .Attachments(i - 1).ChangeFileName(AnhangMsg & "_" & CStr(i) & "." & GetFileExt(mAttachments.Item(i)))
           	Next i
     	End If

     	If Len(mEmpfaenger) > 0 Then 'Sonst kackt VB ab...
        	Call .Recipients.Add(mEmpfaenger)
     	End If
     	.Subject = mBetreff
     	.BodyText.PlainText = mBody

     	Call .Save(TobitArchive, DvMsgSelEMail)

     	'HKEY_CURRENT_USER\Software\Tobit\Tobit InfoCenter\Settings
     	Set RegistryOBJ = New RegistryCLS
     	With RegistryOBJ
        	Set RegSettingOBJ = .ReadSetting(CurrentUser, "Software\Tobit\Tobit InfoCenter\Settings", "ProgramDirectory")
        	TobitProgname = CheckPath(RegSettingOBJ.Setting) & "DVWIN32.EXE"
     	End With
     	Set RegistryOBJ = Nothing
     	Set RegSettingOBJ = Nothing


     	'Genereller Aufbau für das Aufrufen von Einträgen aus dem Tobit Archive System
     	'Syntax: DVWIN32.EXE [PATH] /POS=n /SA=n (+ weitere Modifier s.u.)

     	'a.. POS = Position in Archive.DAT
     	'a.. SA = Typ (9 = Job, 34 = Archive)
     	'Shell "C:\Programme\Tobit InfoCenter\DVWIN32.EXE " & oArchive.ID & " /SA=34 /POS=iPosNo", vbNormalFocus

     	ShellStr = TobitProgname
     	ShellStr = ShellStr & " " & TobitArchive.ID & " /SA34 /POS="

     	Set TobitArchive = Nothing

     	'Archiv neu einlesen
     	Set TobitArchive = myTobitAccount.GetSpecialArchive(DvArchivePersonalOut)
     	Set TobitMessageItems2 = TobitArchive.GetArchiveEntries(DvFilterDefault)

     	For Each TobitMessageItem2 In TobitMessageItems2
        	If .Subject = TobitMessageItem2.Subject Then

           	ShellStr = ShellStr & TobitMessageItem2.Fields("RecNo").Value
           	Call Shell(ShellStr, vbNormalFocus)
           	Exit For
        	End If
     	Next TobitMessageItem2
     	Set TobitMessageItems2 = Nothing
  	End With
  	Set TobitMailItem = Nothing
  	myTobitAccount.Logoff
   Else
  	'Das Logon am Tobitserver konnte nicht durchgeführt werden!
  	Set myTobitAccount = Nothing
   End If
   Set TobitArchive = Nothing
End Sub