Domino 9 und frühere Versionen > ND9: Administration & Userprobleme
E-Mailversand aus Excel geht mit LN 9 nicht mehr
Benni1988:
Es funktioniert :)so und anbei der gesamte Code, um mehrere Empfänger mit einer persönlichen Anrede anschreiben zu können, + Signatur und + zwei möglichen Anhängen
Option Explicit
Sub CommandButton1_Click()
If MsgBox("Sollen die E-Mail(s) gesendet werden?", vbQuestion + vbYesNo, _
"Löschen bestätigen") = vbYes Then
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, sAnhang2 As String, sAnhang3 As String
Dim profile As Object
Dim RTSig As Object
Dim i As Long
Dim sAnrede As Variant
Dim sVorname As Variant
Dim sNachname As Variant
Dim tempAnrede As Variant
On Error GoTo Fehler
'*************************************************************************************************************
For i = 12 To cells(Rows.Count, 9).End(xlUp).Row ' von Zeile 12 in Spalte 9 bis zur letzten beschriebenen Zeile in Spalte 9
vAn = cells(i, 9) ' e-Mail an alle Empfänger, die ab Zeile 12 in Spalte 9 stehen
sBetrifft = Range("b3") ' die Betreffzeile der E-Mail steht in Zelle "B3"
sAnrede = Range("e" & i) ' nehme Anrede aus Spalte e
Select Case (sAnrede)
Case "Herr": 'Im Fall, dass Anrede "Herr" in Spalte e, dann schreibe "Sehr geehrter Herr"
tempAnrede = "Sehr geehrter Herr"
Case "Frau":
tempAnrede = "Sehr geehrte Frau" 'Im Fall, dass Anrede "Frau" in Spalte e, dann schreibe "Sehr geehrte Frau"
Case "Sehr geehrte Damen und Herren":
tempAnrede = "Sehr geehrte Damen und Herren"
Case "Dear":
tempAnrede = "Dear" 'Im Fall, dass Anrede "Dear" in Spalte e, dann schreibe "Dear"
End Select
sVorname = Range("f" & i) 'Nehme den Vorname aus Spalte f
sNachname = Range("g" & i) 'Nehme den Vorname aus Spalte g
If Sheets("Tabelle1").Range("h" & i).Value = "Deutsch" Then ' wenn in Spalte h ab Zeile 12 als Sprache "Deutsch" eingetragen ist, dann
sText = tempAnrede & " " & sNachname & "," & Chr(10) & Chr(10) & Range("B4") & Chr(10) ' nehme die gewählte Anrede + Nachnamen + den Text aus Zelle "B4"
Else
sText = tempAnrede & " " & sVorname & "," & Chr(10) & Chr(10) & Range("D4") & Chr(10) 'sonst nehme Anrede + Vorname + Text aus Zelle "D4"
End If
sKopie = Range("d3") ' Kopie an E-Mail Empfänger aus Zelle "D3", bei mehreren, Einträge durch " ; " getrennt
sBlindKopie = " " ' Einträge durch " ; " getrennt
sAnhang = Range("b6") ' Link zum Anhang1 in Zelle "B6"
sAnhang2 = Range("b7") ' Link zum Anhang2 in Zelle "B7"
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 ' Bereff E-Mail aus sBetrifft
Set profile = db.GetProfileDocument("CalendarProfile") ' Nehme das LN Profile aus dem "Calender Profile"
Set RTSig = profile.GetFirstItem("Signature_Rich") '
Set rtitem = doc.CreateRichTextItem("body")
Call rtitem.AppendText(sText)
Call rtitem.AddNewLine(2) ' füge nach dem text noch zwei leere Zeilen ein
Call rtitem.AppendRTItem(RTSig) ' Kopiere RTSig in den Body
doc.SAVEMESSAGEONSEND = True
doc.PostedDate = Now
If sAnhang <> "" Then
Call rtitem.EMBEDOBJECT(1454, "", sAnhang) 'hänge Anhang an
Call rtitem.EMBEDOBJECT(1454, "", sAnhang2) 'hänge Anhang2 an
End If
rtitem.saveToDisk = True
'***********************************************************************************************************************************
Call doc.Save(True, False)
Call doc.Send(False)
Next i
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:
MsgBox "Fehler in Sub Fehler 0 Erste Division" & vbCrLf _
& "Fehlernummer: " & Err.Number & _
vbCrLf & "Fehlerbeschreibung: " & Err.Description
End If
End Sub
Noch einmal vielen Dank für eure Hilfe
Benni1988:
Hallo zusammen,
jetzt bin ich es noch einmal :)
An was kann das liegen, dass der Code bei einem Kollegen funktioniert hat und jetzt nicht mehr funktioniert? (Es wird die gleiche Datei verwendet, auch bei anderen Kollegen geht diese Datei)
Er bekommt immer follgende Fehlermeldung:
Fehlernummer: -2147417851
Fehlerbeschreibung: Automatisierungsfehler
Ausnahmefehler des Servers
Vielen Dank im Voraus
Grüße
Benni
schroederk:
Wenn der Code mal funktioniert hat und jetzt nicht mehr, muss sich etwas geändert haben.
Das können ganz banale Berechtigungsänderungen sein oder auch geänderte Werte, die übergeben werden.
Bspw. kein valides Datum.
Oder auf der Office-Seite und damit die API hat sich vielleicht geändert.
Hast Du mal nach der Fehlermeldung gegoogelt? Wobei ich wohl nach der englischen Version des Fehlers (automation error) suchen würde, da findet man meist mehr Ergebnisse als mit der deutschen Fehlermeldung.
DerVissi:
Sowas kommt auch vor wenn unterschiedliche Windows User verwendet werden.
z.B.
Excel oder Notes sind als Administrator gestartet.
Das jeweils andere Programm wird vom normalen User verwendet.
Benni1988:
Er ist überall als Admin angemeldet, allerdings wurde bei Ihm die Abreitsumgebung von Lotus Notes geändert.
Bei google habe ich noch nichts mit dem gleichen Problem gefunden. Aber das wird dann an der Arbeitsumgebung liegen, nehme ich an.
Navigation
[0] Themen-Index
[*] Vorherige Sete
Zur normalen Ansicht wechseln