Ich komme einfach nicht drauf:-(((
03.09.2014 14:39:18
Alexa
ich habe folgenden Code geschrieben:
Es soll eine Mailbenachrichtigung (nur: es wurde ein neuer Kunde hinzugefügt) geschickt werden, wenn in dem UserForm 1 der Button "Übernehmen" gedrückt wird. Der Code in sich ist anscheinend richtig, da keine Fehlermeldung kommt, aber ich bekomme keine Mail. Der sub wird in der Clickfunktion von dem "Übernehmen"-Button aufgerufen.
Wo liegt mein Fehler?
Könnt ihr mir bitte helfen?
Vielen Dank schon mal
Lg Alexa
Private Sub lotus()
Dim sText As String, sEmpfang As String, sBetrifft As String
Dim session As Object, db As Object, doc As Object, rtobject As Object
Dim rtitem As Object, sKopie As String
Dim AttachMe As Object, DerAnhang As Object
Dim user As String, server As String
Dim mailfile As String, sBlindKopie As String
Dim vAn As Variant, vCopy As Variant
Dim vBlind As Variant, sAnhang As String
On Error GoTo Fehler
sText = "Test " & vbCrLf & "Zweite Zeile" ' Testtext
sText = "Info:Es wurde ein neuer Kunde angelegt" ' Zeilenumbrüche ändern
sEmpfang = "alexa@googlemail.com" ' Einträge durch " ; " getrennt
sBetrifft = "Info:neuer Kunde" ' die Betreffzeile
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
Set rtitem = doc.CREATERICHTEXTITEM("body")
Call rtitem.APPENDTEXT(sText)
doc.SAVEMESSAGEONSEND = True
doc.PostedDate = Now
Call doc.Send(False)
Aufraeumen:
On Error Resume Next
Set rtitem = Nothing
Set AttachMe = Nothing
Set DerAnhang = Nothing
Set db = Nothing
Set doc = Nothing
Set session = Nothing
Exit Sub
Fehler:
Resume Aufraeumen
End Sub