Hi,
dieses Skript liegt auf einer SENDEN Schaltfläche. Ich benötige eine zusätzliche Funktion in dem Skript, dass vor dem senden eine Rechtschreibprüfung auf das Dokument stattfindet.
Sub Click(Source As Button)
On Error Goto ErrorHandling
Dim workspace As New NotesUIWorkspace
Dim session As New NotesSession
Dim db As NotesDatabase
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim maildoc As NotesDocument
Dim item As NotesItem
Dim bodyRT As NotesRichtextItem, grussRT As NotesRichtextItem
Dim UNIDFeld As Variant
Dim MailAdrFeld As Variant
Dim zieldoc As NotesDocument
Dim mainkonfdoc As NotesDocument
Dim neudoc As NotesDocument
Dim k As Integer
Dim resDB As NotesDatabase
Dim resdoc As NotesDocument
Dim em As String
Dim EMess As String
Set uidoc = workspace.CurrentDocument
Set db = session.CurrentDatabase
If GetKonfigDB ( "", "profilServer", "profilFile", resDB, EMess ) = False Then Error 15010, EMess
If HoleRessourcenDoc ( GetAbbreviateUserName ( Session.UserName ), resDB, resdoc , EMess ) = False Then Error 15010, EMess
Set mainkonfdoc = GetConfigDoc("MAIN")
If mainkonfdoc Is Nothing Then
Msgbox "No main configuration available ?!?"
Exit Sub
End If
Call uidoc.FieldSetText( "MailStatus", "2" )
Call uidoc.FieldSetText("DokStatus", "3")
Call uidoc.save
Set doc = uidoc.Document
Set maildoc = db.CreateDocument
maildoc.Subject = doc.Subject(0)
Set item = doc.GetfirstItem("Body")
Call item.CopyItemToDocument(maildoc, "")
maildoc.from = doc.From(0)
maildoc.SendTo = doc.SendTo
maildoc.CopyTo = Evaluate("CopyTo : AKMCopyTo", doc)
maildoc.BlindCopyTo = doc.BlindCopyTo
maildoc.DeliveryPriority = doc.DeliveryPriority
maildoc.ReturnReceipt = doc.ReturnReceipt
maildoc.DeliveryReport = doc.DeliveryReport
Call maildoc.send(False)
Messagebox " Mail was sent! ", MB_IconInformation, "Mail dispatching"
Print("Mail transferred for delivery")
UNIDFeld = doc.AKMRef
MailAdrFeld = doc.AKMCopyTo
anz = Ubound(UNIDFeld) 'fängt bei Null an!!
If anz = 0 Then
If UNIDFeld(0) = "" Then Exit Sub
End If
Print("Create mail references")
For k = 0 To anz
Set zieldoc = db.GetDocumentByUNID(UNIDFeld(k))
If zieldoc Is Nothing Then
Messagebox "The mail reference could not be created:" + Chr$(10) + MailAdrFeld(k)
Else
If ErzeugeMailReferenz ( db, resdoc, zieldoc, doc, 2, mainkonfdoc.f_MailReferenzen ( 0 ), neudoc, mainkonfdoc, EMess ) = False Then Error 15010, EMess
If neudoc.Save( True, False, True ) = False Then Error 1010, "The mail reference for document " & Cstr ( zieldoc.UniversalID ) & Chr ( 10 ) & _
"could not be saved in AKM !"
End If
Next
Print("Mail references created")
Exit Sub
ErrorHandling:
ErrorNr = Err
Select Case ErrorNr
Case 4091
Set zieldoc = Nothing
Resume Next
Case Else
End Select
Messagebox Error$ & "(" & Cstr(ErrorNr) & ") [Zeile " & Cstr ( Erl ) & "]", 16, "Error:"
Exit Sub
End Sub
In der Designer Hilfe habe ich nur eine Funktion gefunden (@Command( [ToolsSpellCheck] )) die mir aber in diesem Fall nicht nuzt.
Kann mir jemand das Skript ergänzen?
Gruss
Olli