Hallo zusammen,
bitte nicht wundern, ich habe das Problem im Forum "Herbers-Excel Forum" auch gepostet, dort wurde mir allerdings euer Forum dazu empfohlen..
Ich habe vor einen halben Jahr ein Makro geschrieben (mit Hilfe aus verschiedenen Foren), mit dem ich aus Excel heraus diverse E-Mails in Lotus Notes 8.5 versenden konnte. Dies hat auch einwandfrei funktioniert.
Nun haben wir aber auf Lotus Notes 9 umgestellt und ich bekomme immer die Fehlermeldung
"Systemfehler &H800 10 105 (-2147417851). Ausnahmefehler des Servers"
An was könnte das liegen? Vielen Dank für eure Hilfe.
Anbei mein Code:
Sub CommandButton1_Click()
If MsgBox("Sollen die E-Mail(s) gesendet werden?", vbQuestion + vbYesNo, _
"Löschen bestätigen") = vbYes Then
Dim sText As Variant, sEmpfang As Variant, sBetrifft As String
Dim session As Variant, db As Variant, doc As Variant, rtobject, ws As Variant
Dim x As Integer, y As Integer, Msg As Integer
Dim sKopie As String, AttachMe As Variant, DerAnhang As Variant
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
Dim sAnrede As Variant
Dim sVorname As Variant
Dim sNachname As Variant
Dim tempAnrede As Variant
' Verbindung zum Mailserver aufbauen
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) ' Emails zusammenbauen _
und rausschicken
For i = 12 To cells(Rows.Count, 9).End(xlUp).Row
If cells(i, 10) <> "ja" Then 'keine E-Mail, wenn "ja" _
in Spalte "geantwortet"
vAn = cells(i, 9)
sAnrede = Range("e" & i) '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) 'Vorname aus Spalte f
sNachname = Range("g" & i) 'Nachname aus Spalte g
If Sheets("Tabelle1").Range("h" & i).Value = "Deutsch" Then 'wenn in Spalte "h" " _
Deutsch" als Sprache steht, dann
sText = tempAnrede & " " & sNachname & "," & Chr(10) & Chr(10) & Range("B4") & Chr(10) _
'dann nehme die 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
sBetrifft = Range("B3") ' Überschrift in Zelle b3
sKopie = Range("D3") ' Kopie der E-MAil an e- _
Mail Adresse aus Zelle "D3"
sBlindKopie = Mid(vAn, 3) ' schickt an alle Empfä _
nger eine Blindkopie
sAnhang = Range("B6") ' Link aus Zelle b6
sAnhang2 = Range("B7") ' Link aus Zelle b7
sAnhang3 = Range("B8") ' Link aus Zelle b8
If Len(sKopie) > 0 Then vCopy = Split(sKopie, " ; ") ' cc Array
If Len(sBlindKopie) > 0 Then vBlind = Split(sBlindKopie, " ; ") 'bcc Array
Set doc = db.createdocument()
doc.Form = "Memo"
doc.sendto = vAn
If Len(sKopie) > 0 Then doc.CopyTo = vCopy 'cc 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)
Set DerAnhang2 = AttachMe.EMBEDOBJECT(1454, "", sAnhang2)
Set DerAnhang3 = AttachMe.EMBEDOBJECT(1454, "", sAnhang3)
',"Attachment" wird nicht benötigt
End If
'*******************************
Set ws = CreateObject("Notes.NotesUIWorkspace")
' **durch das öffnen des Dokumentes durch NotesUIWorkspace**
' **erreicht man das die eingestellte Signatur aus den **
' **Lotus Notes Optionen eingefügt wird
Call ws.EDITDOCUMENT(True, doc)
Set doc = ws.CURRENTDOCUMENT
Call doc.GOTOFIELD("Body")
Call doc.insertText(sText)
Call doc.Send(True)
Call doc.Close 'Schliesst das gesendete Formular
Call doc.Save(True, True)
Set AttachMe = Nothing
Set DerAnhang = Nothing
Set ws = Nothing
Set doc = Nothing
End If
Next i
' Verbindung zum Mailserver löschen
Aufraeumen:
On Error Resume Next
Set db = Nothing
Set session = Nothing
Exit Sub
Fehler:
Resume Aufraeumen
End If
End Sub
Ich bin noch ein ziemlicher Anfänger, wenn es um Makros geht.
Ich hoffe, aus dem Post wird mein Problem ersichtlich
vielen Dank für eure Hilfe
Viele Grüße
Benni