Hallo Zusammen,
vorab ich hab bisher mit VBA fast keine Erfahrungen sammlen können hab aber auf der Arbeit derzeit eine Aufgabenstellung die sich meiner Auffassung nach gut darüber lösen lassen müsste und ich hoffe hier kann mir jemand dabei helfen ;D.
Die Aufgabe ist es Daten für eine Serien-Mail aus einem Excel-Sheet auszulesen und diese zusammen mit einem Dateianhang über LotusNotes zu versenden.
Ich hab durch fleissiges Suchen bei Google mir folgenden Code zusammengestellt der auch perfekt funktioniert:
Sub LotusMail(Empfaenger As String, Dateianhang As String, Inhalt As String)
Dim Kopie_Empfänger As String, BlindKopie_Empfänger As String, Betreff As String
Const EMBED_ATTACHMENT = 1454
Dim server As String, mailfile As String
Dim session As Object
Dim DB As Object
Dim doc As Object
Dim rtitem As Object
Dim EmbeddedObject As Object
Dim Cell As Range
' Auslesen der Mail-DB
Set session = CreateObject("Notes.NotesSession")
server = session.GetEnvironmentString("MailServer", True)
mailfile = session.GetEnvironmentString("MailFile", True)
Set DB = session.GETDATABASE(server, mailfile)
Set doc = DB.CreateDocument()
doc.Form = "New"
doc.SendTo = Empfaenger ' Adressaten übergeben
' doc.CopyTo = Me.Kopie_Empfänger.Value
' doc.BlindCopyTo = Me.BlindKopie_Empfänger.Value
doc.Subject = "Kundenliste Bestandsaktion"
doc.Body = Inhalt
Dateianhang = ThisWorkbook.Worksheets("Tabelle1").Range("f2").Value
Set rtitem = doc.CREATERICHTEXTITEM("ProjectDescription")
Set EmbeddedObject = rtitem.EMBEDOBJECT(EMBED_ATTACHMENT, "", Dateianhang) 'Dateianhang mit Pfad und Dateiname überschreiben
'doc.SIGN = "0"
'doc.ENCRYPT = "0"
'doc.BlindCopyTo = ""
'doc.DefaultMailSaveOptions = 0 '"1"
'doc.MailSaveOptions = 0 '"1"
'doc.DeliveryReport = "B"
doc.MailOptions = 0
doc.Importance = "1"
doc.logo = "Ltr_GliGruppeDE"
'doc.ReturnReceipt = "1"
doc.principal = session.UserName
doc.viewicon = "75"
doc.FROM = session.UserName
doc.SAVEMESSAGEONSEND = True
doc.SaveOptions = 1
' doc.SecureMail = ""
doc.SenderTag = N
doc.useApplet = True
doc.CalendarProfile = True
'SMTP-Originator
doc.PostedDate = Format$(Now, "dd.mm.yyyy") + " " + Format$(Now, "hh:nn:ss")
' Call doc.Save(False, False)
Call doc.Send(True, "")
Set doc = Nothing
Set DB = Nothing
End Sub
Sub Mail_Senden()
'Für jede Zelle in Bereich d2 bis zur letzen belegten Zelle in Spalte d wird eine Mail versandt.
Dim Cell As Range
For Each Cell In Range("d2:d" & Cells(Rows.Count, "d").End(xlUp).Row)
If Cell <> "" Then Call LotusMail(Cell.Value, "", Cell(1, -2) & " " & Cell(1, -1) & " " & Cell(1, 0) & vbLf & "," & Range("g2").Text & Cell(1, 2) & vbLf & Range("h1").Text)
Next
End Sub
Es soll also folgendermassen laufen Empfänger 1 (definiert in Zelle D2) erhält Anhang 1 (definiert in Zelle I2), Empfänger 2 (definiert in Zelle D3) erhält Anhang 2 (definiert in Zelle I3),...usw.
Die Überlegung war den Code zu einer Schleife umzuarbeiten, ich hab aber ehrlich gesagt keinen Schimmer wo ich da ansetzen soll. Wäre Super wenn hier jemand einen Lösungsansatz hätte.
MFG Nico
Stimmt :D Wie war das mit dem Wald und den Bäumen.
Das heisst also das ich eigentlich nur Dateianhang = ThisWorkbook.Worksheets("Tabelle1").Range("f2").Value
Das Problem ist wie mache ich das? Mir fehlen leider gewisse Grundlagen um zu wissen welche Ausdrücke ich wann wo einzusetzen habe. Wäre nett wenn mir da auf die Sprünge geholfen werden könnte :D
ES KLAPPT! Muchas Gracias! Vielen, Vielen, Dank Bernhard!
Das sind so Momente wo man sich mal kräftig mit der flachen Hand an die Strin klatschen sollte...
Ich hab schon bemerkt das ich mit der Zeile den Empfänger und den Inhalt übergeben kann, Mir ist aber natürlich nicht in den Sinn gekommen das man hier evtl. auch den Dateianhang definieren könnte... Ich hab mich zu sehr auf den Eintrag Dateianhang = ThisWorkbook.Worksheets("Tabelle1").Range("f2").Value
Also nochmals vielen Dank!!! Kann dann sogar noch pünktlich Feierabend machen und ich hab was essentielles über VBA gelernt!!!
MFG Nico