Dafür, dass Du Anfänger bist, sieht der Code (von den Dingen, die Alex angemerkt hat abgesehen) echt anständig aus. Dein Problem: Du kennst nicht den Unterschied zwischen einem NotesDocument und einem NotesUIDocument.
Beide sehen sehr ähnlich aus, haben aber unterschiedliche Methoden.
Die ZeileSet doc = db.createdocument()
erstellt ein Objekt der Klasse "NotesDocument". Das ist ein Backend- Objekt und spiegelt das Dokument wieder, wie es nachher auf der Platte landet.
Die ZeileSet doc = ws.CURRENTDOCUMENT
weist der Variablen ein Objekt der Klasse "NotesUIDocument" zu. Es repräsentiert das, was Du als Benutzer im Lotus Notes Client siehst.
Das NotesUIDocument hat eine Property "Document", mit der Du wieder zum Backend- Dokument der Klasse "NotesDocument" kommen würdest.
Dummerweise haben sowohl die NotesDocument als auch NotesUIDocument- Klasse eine Methode "Send". Nur dass die Methode unterschiedliche Parameter hat:
Aus der Designer- Hilfe (die Du auch z.B. hier (http://www-01.ibm.com/support/knowledgecenter/SSVRGU_9.0.0/com.ibm.designer.domino.main.doc/H_NOTESDOCUMENT_CLASS.html) online findest:NotesDocument.Send
Syntax
Call notesDocument .Send( attachForm [, recipients ] )
Parameters
attachForm
Boolean. If True, the form is stored and sent along with the document. If False, it isn't. Do not attach a form that uses computed subforms.
recipients
String or array of strings. Optional. The recipients of the document. See below.
NotesUIDocument.Send
Syntax
Call notesUIDocument .Send
Usage
The document must contain a SendTo field indicating the recipients.
There are two kinds of fields that affect the mailing of the document:
If the document contains additional recipient items, such as CopyTo or BlindCopyTo, Notes mails the documents to these recipients, too.
If the document contains items to control the routing of mail, such as DeliveryPriority, DeliveryReport, or ReturnReceipt, Notes uses these when sending the document.
Also musst Du entweder Die Methode des uidoc ohne Parameter verwenden, oder eben die Zeile Set doc = ws.CURRENTDOCUMENT
so anpassen Set doc = ws.CURRENTDOCUMENT.Document
SO: Das ganze Crashed also in "ntdll.RtlInitializeExceptionChain", hat also was mit dem Richtextitem zu tun, in das Du die Attachments schreibst.
Du schreibst die Attachments "irgendwohin" nämlich in ein Item "Attachments". Das ist im Client nicht vorgesehen, deshalb müssen die Attachments zur Anzeige in ein anderes Item verschoben werden, vermutlich knallt es dabei.
Nimm das "richtige" Item, das könnte das Problem schon beheben. Statt Set AttachMe = doc.CREATERICHTEXTITEM("Attachment")
schreibe Set AttachMe = doc.CREATERICHTEXTITEM("Body")
und berichte.
Verursacht "Call doc.Send(True)" den Notes-Client-Absturz? Wenn Ja, dann fallen mir zwei Möglichkeiten ein, eine Notes-Mail im Frontend zu versenden ohne im Excel ein uiDoc.send aufzurufen. Davon mal abgesehen kann man auch im Backend die Signatur hinzufügen ;) Was nach wie vor meine Lösung wäre, aber OK ...
Von den 2 Möglichkeiten gibt es einen der recht einfach umzusetzen ist:
AppActivate "IBM Notes"
SendKeys "%1"
Ggf. musst du die Parameter noch anpassen oder fügst einen weiteren AppActivate-Aufruf zum Zurückspringen hinzu.
Und taste dich heran, wie es dir Peter empfohlen hat, das ist ein guter Tipp.
entschuldigt bitte, wenn das so rüber kommt, als ob ich eure Ratschläge nicht verwende. Wie gesagt ich bin Anfänger, aber versuche immer alles umzusetzen.
Ich bin ja froh, dass ich Hilfe bekomme.
Ich habe jetzt auch versucht wieder von vorne anzufangen und das ohne Uidocument.
Option Explicit
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
sEmpfang = "test@test.de" ' bei mehreren Email Adressen durch " ; " getrennen
sBetrifft = "Test" ' die Betreffzeile
sText = "funktioniert es? " ' Testtext
sKopie = " " ' bei mehreren Email Adressen durch " ; " getrennen
sBlindKopie = " " ' bei mehreren Email Adressen durch " ; " getrennen
vAn = Split(sEmpfang, " ; ") ' Empfänger Array
sAnhang = "" ' richtiger Pfad Muss natürlich richtig gesetzt werden
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
' *******************************************
If sAnhang <> "" Then
Set AttachMe = doc.CREATERICHTEXTITEM("Attachment")
Set DerAnhang = AttachMe.EMBEDOBJECT(1454, "", sAnhang, "Attachment")
End If
'*******************************
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
so bekomme ich es halb hin, das heißt e-Mail geht, Anhang kann mit versendet werden, nur keine Signatur. Also habe ich folgendes probiert
Option Explicit
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 signature As Object
Dim vBlind As Variant, sAnhang As String
On Error GoTo Fehler
sEmpfang = "test1@test.de" ' Einträge durch " ; " getrennt
sBetrifft = "Test" ' die Betreffzeile
sText = "funktioniert es? " ' Testtext
sKopie = " " ' Einträge durch " ; " getrennt
sBlindKopie = " " ' Einträge durch " ; " getrennt
vAn = Split(sEmpfang, " ; ") ' Empfänger Array
sAnhang = "" ' richtiger Pfad Muss natürlich richtig gesetzt werden
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
signature = db.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
Set rtitem = doc.CREATERICHTEXTITEM("body")
Call rtitem.APPENDTEXT(sText & signature)
doc.SAVEMESSAGEONSEND = True
doc.PostedDate = Now
' *******************************************
If sAnhang <> "" Then
Set AttachMe = doc.CREATERICHTEXTITEM("Attachment")
Set DerAnhang = AttachMe.EMBEDOBJECT(1454, "", sAnhang, "Attachment")
End If
'*******************************
Call doc.Send(False)
Aufraeumen:
On Error GoTo Fehler
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
hier passiert allerdings überhaupt nichts...sobald ich
signature = db.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
einfüge.
Wieso?
Und verliert bitte nicht die Geduld, ich gebe mir Mühe :)
@jBubbleBoy : ich nehme erstmal Peters Vorschlag an, und fange neu an
Ich habe jetzt den On Error goTo Fehler eingebaut.
Und habe folgende Meldung erhalten
Fehler in Sub Fehler 0 erste Division
Fehlernummer: -2147417851
Fehlerbeschreibung: Automatisierungsfehler
Ausnahmefeler des Servers
Damit ich nicht zwei Parameter habe, habe dann ich folgendes geändert:
doc.Subject = sBetrifft ' die Betreffzeile
stSignature = db.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
Set rtitem = doc.CREATERICHTEXTITEM("body")
Call rtitem.APPENDTEXT(sText & stSignature)
doc.SAVEMESSAGEONSEND = True
doc.PostedDate = Now
und bekomme folgende Fehlermeldung
Fehler:
MsgBox "Fehler in Sub Fehler 0 Erste Division" & vbCrLf _
& "Fehlernummer: " & Err.Number & _
vbCrLf & "Fehlerbeschreibung: " & Err.Description
Und bekomme folgende Meldung:
Fehler in sub Fehler 0 erste division
Fehlernummer: 0
Fehlerbeschreibung:
Grüße
Der zweite Parameter ist optional. Das steht auch so in der Hilfe.
Nun gut, er sollte nicht stören...
Splitte die Fehlerzeile mal, nicht das der Fehler an einer unerwarteten Stelle liegt:
calendarProfile = db.getProfileDocument("CalendarProfile", "")
signature = calendarProfile.getItemValue("Signature")(0)
so..:)
Bei
doc.Subject = sBetrifft ' die Betreffzeile
calendarProfile = db.GetProfileDocument("CalendarProfile")
Signature = calendarProfile.GetItemValue("Signature")(0)
Set rtitem = doc.CREATERICHTEXTITEM("body")
Call rtitem.APPENDTEXT(sText & Signature)
doc.SAVEMESSAGEONSEND = True
doc.PostedDate = Now
kommt folgende Fehlermeldung
Fehlernummer: 91
Fehlerbeschreibung: Objektvariable oder With-Blockvariable nicht festgelegt
Also liegt es wohl an der Zeile..
Bin leider langsam echt am verzweifeln:(
Noch einmal eine andere Frage, was spricht denn genau gegen ein UiDocument?
Es war deine Aussage, das der Notes-Client abstürzt und das Problem wurde noch nicht gelöst, oder hast du das mal ausprobiert? =>
AppActivate "IBM Notes"
SendKeys "%1"
Ich habe es jetzt mal mit Debug.Print versucht.
Option Explicit
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
Dim stSignature As String
On Error GoTo Fehler
sEmpfang = "test" ' Einträge durch " ; " getrennt
Debug.Print sEmpfang
sBetrifft = "Test" ' die Betreffzeile
Debug.Print sBetrifft
sText = "funktioniert es? " ' Testtext
Debug.Print sText
sKopie = " " ' Einträge durch " ; " getrennt
Debug.Print sText
sBlindKopie = " " ' Einträge durch " ; " getrennt
Debug.Print sBlindKopie
vAn = Split(sEmpfang, " ; ") ' Empfänger Array
Debug.Print vAn
sAnhang = "" ' richtiger Pfad Muss natürlich richtig gesetzt werden
Debug.Print sAnhang
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
Debug.Print session
user = session.UserName
Debug.Print user
server = session.GetEnvironmentString("MailServer", True)
Debug.Print server
mailfile = session.GetEnvironmentString("MailFile", True)
Debug.Print mailfile
Set db = session.getdatabase(server, mailfile)
Set doc = db.createdocument()
doc.form = "Memo"
Debug.Print doc.form
doc.sendTo = vAn ' an array
Debug.Print doc.sendTo
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
Debug.Print doc.Subject
stSignature = db.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
Debug.Print stSignature
Set rtitem = doc.CREATERICHTEXTITEM("body")
Debug.Print rtitem
Call rtitem.APPENDTEXT(sText & stSignature)
Debug.Print rtitem
doc.SAVEMESSAGEONSEND = True
doc.PostedDate = Now
' *******************************************
If sAnhang <> "" Then
Set AttachMe = doc.CREATERICHTEXTITEM("Attachment")
Set DerAnhang = AttachMe.EMBEDOBJECT(1454, "", sAnhang, "Attachment")
End If
'*******************************
Call doc.Send(False)
Fehler:
MsgBox "Fehler in Sub Fehler 0 Erste Division" & vbCrLf _
& "Fehlernummer: " & Err.Number & _
vbCrLf & "Fehlerbeschreibung: " & Err.Description
Aufraeumen:
On Error GoTo Fehler
Set rtitem = Nothing
Set AttachMe = Nothing
Set DerAnhang = Nothing
Set db = Nothing
Set doc = Nothing
Set session = Nothing
Exit Sub
End Sub
Allerdings springt er immer . wenn ich bei sAnhang ankomme, direkt nach unten und bringt mir die Fehlermeldung (durch MsgBox)
Fehlernummer:13
Fehlerbeschreibung: Typen unverträglich
Die anderen Debug.Print bzw Haltepunkte werden übersprungen...wieso?
Hab ich mal wieder was flasch gemacht?
@jBuubleboy: Dadurch stürzt LN auch ab. Musste es aber auf AppActivate (IBM Notes Mail) ändern
ich kann Lotus Notes leider nur "online" benutzen, sprich meine ID, usw liegt auf dem Firmennetzwerk. Das ist bei uns irgendwie Vorgabe...
Kann das also nicht testen...
Du kannst ein File vom Netz nicht auf lokal kopieren?
Also ist die Fehlerzeile diese hier:
Set session = CreateObject("notes.notessession") ' Notes muss gestartet sein
?
Wenn ja, dann hau die Prints raus und mach eine vor der Zeile und eine nach der Zeile.
Dann musst Du nur noch hinbekommen das diese Zeile funktioniert.
Um den Spass, weil es bei Windows mit DDLs auch so ist, ersetze die Zeile mal mit:
Set Session = CreateObject("Notes.NotesSession")
Hast Du Dein Notes gestartet, oder ist es aus?
EDIT:
Falls alles nicht hilft kannst Du auch Notes über COM ansprechen
Set session = CreateObject("Lotus.NotesSession")
Ist persönlich mein Favorit, aber UI Klassen kann man da nicht benutzten.
Nein, das kann bzw. darf ich nicht... und ja Lotus Notes ist gestartet.
Wenn ich es über
Set session = CreateObject("Lotus.NotesSession")
anspreche, kommt folgende Fehlermeldung
Fehlernummer: -2147217013
Fehlerbeschreibung: Die Methode 'Username' für das Objekt 'ISession' ist fehlgeschlagen
Zwischen "doc.PostedDate = Now" und "Fehler:" nimm mal diesen Code:
doc.PostedDate = Now
If sAnhang <> "" Then
Call rtitem.EMBEDOBJECT(1454, "", sAnhang)
end if
rtitem.saveToDisk = True
Call doc.Send(False)
exit sub
Fehler:
Erstelle und verwende als Anhang ein einfaches Beispiel (zum Testen), z.B. "C:\mein.txt".
In Excel, im Debugger können einzelne Zeilen mit F8 durchlaufen werden, eine gute Methode um Variablen zu überwachen und Fehler zu finden.
Guten Morgen,
so senden mit Anhang geht ohne Fehlermeldung, beim ersten Mal. Dann kommt wieder eine Fehlermeldung.
Fehlerbeschreibung: Automatisierungsfehler
Ausnahmefehler des Servers
Aber die Signatur ist immer noch nicht dabei..
mach mal vor dem Send ein Save, und berichte ob und wo der Absturz stattfindet:
call doc.save(true, false)
Eine einfache, lokal und fest hinterlegte Datei erzeugt den gleichen Fehler, spricht Absturz erst beim 2. Senden?