Hallo,
ich verzweile gerade ein wenig. 
Wir verschicken aus unserem ERP-System seit längerer Zeit Mails mit PDF Anhang. Diese werden quasi im Editor geöffnet und müssen dann versendet werden. Da das E-Mail aufkommen aber mittlerweile größer geworden ist, möchten wir diesen Schritt sparen, sodass Tobit die Mails direkt versendet ohne sie anzuzeigen.
Code
Dim oApp
Dim oAccount
Dim oArchive
Dim oItem
Dim oMailItem
Dim oAttachment
Dim TobitPath
Dim TSrv
Dim Template
'TEST ARRAY
'Dim arr_Empfaenger(0, 1)
InitTobit()
Create_NewMail()
'*********************************************************************************
'* SUB InitTobit() *
'*********************************************************************************
Sub InitTobit()
ON ERROR RESUME NEXT
'Initialisiert die Tobit API
'Anwendungsverzeichnis des Tobit InfoCenters aus der Registry auslesen
Set WSHShell = CreateObject( "WScript.Shell" )
ShellCmd = "HKCU\Software\Tobit\Tobit InfoCenter\Settings\ProgramDirectory"
TobitPath = WSHShell.RegRead( ShellCmd )
'Objekt der DvISEAPI erzeugen
Set oApp = CreateObject("DVOBJAPILib.DvISEAPI")
'Account laden (des lokal angemeldeten Benutzers)
Set oAccount = oApp.Logon("", "", "", "", "", "NOAUTH")
'Alle Archive einlesen
Set oArchiveRoot = oAccount.ArchiveRoot
Set oArchives = oArchiveRoot.Archives
'Tobit Servernamen auslesen (Hostname des Tobit Servers in der Regel)
Tsrv = oAccount.ServerName
'Vorlagenverzeichnis einlesen
ShellCmd = "HKCU\Software\Tobit\Tobit InfoCenter\Servers\" & Tsrv & "\TemplateFN"
Template = WSHShell.RegRead( ShellCmd )
'Falls möglich Vorlage einlesen
IF Template <> "" THEN
'Den Pfad abschneiden
Path = Template
filepart = Right(template,13)
Path = replace(template,filepart,"")
'Das Archiv ermitteln
For each oArc in oArchives
IF oArc.ID = Path THEN
'Das MailItem ermitteln
For each obj in oArc.AllItems
IF obj.TextSource = Template THEN
SET oItem = obj
END IF
Next
End IF
Next
END IF
End Sub
'*********************************************************************************
'* SUB Create_NewMail() *
'*********************************************************************************
Sub Create_NewMail()
dim vHtml
dim vAttachment, vSubject, vTo, vBCC
dim vStackSize
'**************************
' Daten holen
vTo = Aeins.JVARS_GET(3551, "JVAR_TEMPWERT_3")
vSubject = Aeins.JVARS_GET(3551, "JVAR_TEMPWERT_2")
vAttachment = Aeins.JVARS_GET(3551, "JVAR_TEMPWERT_4")
vBCC = Aeins.JVARS_GET(3551, "JVAR_VERSANDOUTLOOK_BCC")
vHtml = Aeins.JVARS_GET(3551, "JVAR_TEMPWERT_1")
vHtml = Replace(vHtml, Chr(10) & Chr(10), "<br>")
vHtml = Replace(vHtml, Chr(13), "<br>")
'**************************
'Tobit Archiv einlesen
Set oArchive = oAccount.GetSpecialArchive(102) '102 = Ausgangsarchiv
'Neuen Archiveintrag anlegen
Set oMailItem = oArchive.CreateArchiveEntry(2) '0 = unbekannt, 1 = Adresse, 2 = Email, 3 = Fax, 4 = SMS, 5 = VoiceMail, 6 = TMAIL, 7 = Kalendereintrag, (...)
With oMailItem
.Subject = vSubject
'Empfänger der Nachricht
.Fields("SRTo").Value = vTo
' TEST
' arr_Empfaenger(0, 0) = Aeins.JVARS_GET(3551, "JVAR_TEMPWERT_3")
'arr_Empfaenger(0, 1) = Aeins.JVARS_GET(3551, "JVAR_TEMPWERT_3")
'.Fields("To").Value = arr_Empfaenger
'Priorität der Nachricht
.Fields("Priority").Value = 0 '0 = Normal, 1 = Low, 2 = Important
'Daten der Vorlage einlesen
.Fields("HTMLDisplayContent").Value = vHtml
'vorher StackSize = 1000
vStackSize = 5
Do While vStackSize > 0
vAttachment = ""
vAttachment = Aeins.JVARS_GET(3551, "JVAR_VERSANDOUTLOOK_DATEI_" & vStackSize)
if len(vAttachment) > 0 then
oMailItem.Attachments.Add ""+vAttachment+"", vAttachment
call Aeins.JVARS_SET(3551, "JVAR_VERSANDOUTLOOK_DATEI_" & vStackSize, "")
end if
vStackSize = vStackSize - 1
Loop
'Nachricht speichern
.Save
End With
'Nummer des Eintrags der soeben gespeicherten Email auslesen (wichtig für Shell Aufruf!)
oRecNo = oMailItem.Fields("RecNo").Value
'Über die Shell das InfoCenter starten und dort die soeben erzeugte Nachricht im Editor öffnen
' zum TESTEN mal ausgeklammert BEWIRKT DAS DIE MAIL NICHT IM EDITOR GEÖFFNET WIRD!
'set wshshell = CreateObject( "WScript.Shell" )
'ShellCmd = TobitPath & "\DVWIN32.EXE " & oArchive.ID & " /SA=34 /POS=" & oRecNo
'WSHShell.Exec(ShellCmd)
'Mail sofort wieder löschen nachdem sie geöffnet wurde, da Sie sonst doppelt versendet wird, bzw. 2x im Postausgangsarchiv liegt
oMailItem.Delete
MsgBox vTo
oMailItem.To = vTo
'TEST ob das direkte Senden geht LEGT ANSCHEINEND ADRESSE NICHT AN
oMailItem.Send
'Objekte freigeben um sicherzustellen, dass das Script auch bei mehrmaligem Aufrufen sauber funktioniert
oAccount.Logoff
Set oAccount = Nothing
Set oApp = Nothing
Set oAttachment = Nothing
Set oMailItem = Nothing
Set oArchive = Nothing
Set oArchives = Nothing
Set oItem = Nothing
Set oArchiveRoot = Nothing
End Sub
'*********************************************************************************
'* FUNCTION FixHTMLUmlaute( HTML_Content ) *
'*********************************************************************************
Function FixHTMLUmlaute( HTML_Content )
'Der Funktion wird ein HTML Fragment übergeben.
'In diesem werden dann die Umlaute gegen die entsprechenden Codes ersetzt.
RetValue = Replace(HTML_Content,"ä","ä")
RetValue = Replace(RetValue,"Ä","Ä")
RetValue = Replace(RetValue,"ö","ö")
RetValue = Replace(RetValue,"Ö","Ö")
RetValue = Replace(RetValue,"ü","ü")
RetValue = Replace(RetValue,"Ü","Ü")
FixHTMLUmlaute = RetValue
End Function
Anhand dieses Quelltextes sieht man, dass die eigentliche Editierung schon auskommentiert ist, das funktioniert auch.
Das Problem:
Die To-Adresse wird nicht mit übergeben, der Anhang auch nicht. Es kommt die Meldung "Nummer fehlt" die Mail erscheint im Eingang und im Ausgang. Je 1x.
Ansonsten versuche ich hier an zwei Stellen das To zu füllen, aber ohne Erfolg. Mit Arrays habe ich was versucht... aber ich kann sie nichtmal deklarieren.
Vielleicht habt ihr ja einen Tip.
Danke, LG Fabien
