ich habe es versucht, und stocher ehrlich gesagt ein bisschen im dunkeln und bin total am verweifeln...weil ich es absolut net hinbekomme...
Mit Uidocument konnte ich wenigstens ohne Ahnag versenden, jetzt schließt sich Notes immer gleich..
Wie gesagt, bin ziemlicher Anfänger, aber was mach ich denn falsch?
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 Variant
Dim sEmpfang As Variant
Dim sBetrifft As String
Dim session As Variant
Dim db As Variant
Dim doc As Variant
Dim rtobject As Variant
Dim ws As Variant
Dim x As Integer
Dim Msg As Integer
Dim sKopie As String, AttachMe 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
Dim derAnhang As Variant, derAnhang2 As Variant, derAnhang3 As Variant
Dim sAnhang As String, sAnhang2 As String, sAnhang3 As String
Dim sAnrede As Variant
Dim sVorname As Variant
Dim sNachname As Variant
Dim tempAnrede As Variant
Dim i As Long
' 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)
doc.CREATERICHTEXTITEM ("Attachment")
',"Attachment" wird nicht benötigt
End If
'*******************************
Set ws = CreateObject("Notes.NotesUIWorkspace")
' **durch das öffnen des Dokumentes durch NotesWorkspace**
' **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.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
