Hallo zusammmen,
ich bräuchte mal dringend Hilfe.
Ich möchte eine automatisch generierte Mail aus Excel mittels VBA Skript versenden. Leider wird das Skript durch die Notes Rechtschreibprüfung unterbrochen. Wer weiss wie man die Rechtschreibprüfung unterbinden kann?
Hier der VBA Code, den ich im Internet gefunden habe.
Sub lotus(sEmpfang As String, sKopie As String, sBetrifft As String, sText As String)
Dim session As Object, db As Object, doc As Object, rtobject, ws As Object
Dim AttachMe As Object, DerAnhang As Object
Dim user As String, server As String, mailfile As String, sBlindKopie As String
Dim vAn As Variant, vCopy As Variant, vBlind As Variant, sAnhang As String
On Error GoTo Fehler
'sText = "Erste Zeile!" & vbCrLf & "Zweite" & vbCrLf & "Dritte" ' Testtext
sText = Replace(sText, vbCrLf, Chr(10)) ' Zeilenumbrüche ändern
' sBetrifft = " Beispiel"
'Wenn du keine Kopie od Blindkopie versenden willst, dann grad weglassen
'sKopie = "" ' Einträge durch " ; " getrennt
'sBlindKopie = "Email1 ; Email2 " ' Einträge durch " ; " getrennt
vAn = Split(sEmpfang, " ; ") ' Empfänger Array
sAnhang = "" ' Muss natürlich richtig gesetzt werden C:\TEST.pdf
If Len(sKopie) > 0 Then vCopy = Split(sKopie, " ; ") 'cc Array
If Len(sBlindKopie) > 0 Then vBlind = Split(sBlindKopie, " ; ") 'bcc Array
Set session = CreateObject("notes.notessession") ' Notes muss gestartet sein
user = session.UserName
server = session.GetEnvironmentString("MailServer", True)
mailfile = session.GetEnvironmentString("MailFile", True)
Set db = session.getdatabase(server, mailfile)
Set doc = db.createdocument()
doc.Form = "Memo"
doc.SendTo = vAn ' an array
If Len(sKopie) > 0 Then doc.CopyTo = vCopy 'cc Array
If Len(sBlindKopie) > 0 Then doc.blindcopyto = vBlind 'bcc Array
doc.Subject = sBetrifft ' die Betreffzeile
doc.SAVEMESSAGEONSEND = True
doc.PostedDate = Now
'Die Zeilen mit dem Anhang nach hier oben verschieben, ist wichtig die Reihenfolge
' *******************************************
If sAnhang <> "" Then
Set AttachMe = doc.CREATERICHTEXTITEM("Attachment")
Set DerAnhang = AttachMe.EMBEDOBJECT(1454, "", sAnhang) ',"Attachment" wird nicht benötigt
End If
'*******************************
Set ws = CreateObject("Notes.NotesUIWorkspace") ' **durch das öffnen des Dokumentes durch NotesUIWorkspace**
Call ws.EDITDOCUMENT(True, doc) ' **erreicht man das die eingestellte Signatur aus den **
Set doc = ws.CURRENTDOCUMENT ' **Lotus Notes Optionen eingefügt wird **
Call doc.GOTOFIELD("Body")
Call doc.insertText(sText)
Call doc.Send(True)
Call doc.Close 'Schliesst das gesendete Formular
Call doc.Save(True, True)
Aufraeumen:
On Error Resume Next
Set AttachMe = Nothing
Set DerAnhang = Nothing
Set ws = Nothing
Set doc = Nothing
Set db = Nothing
Set session = Nothing
Exit Sub
Fehler:
Resume Aufraeumen
End Sub