AW: Serienmail mit Anhang
11.03.2014 16:25:08
Klaus
Hallo Larissa,
damit kann ich leider nichts anfangen. Ich habe aber mein "Standard"-Outlook Script rausgekramt und an deine Zwecke angepasst. Funktioniert so zumindest auf meinem PC. Eine Fehlerbehandlung hat meine Version nicht, die könnte man aber nachrüsten.
Ich finds ja schön, wenn die Mails etwas persöhnlicher werden. Also meinetwegen mit "Hallo Frau Petra Zorn" anfangen. Die Informatione dazu sind ja in der Tabelle vorhanden. Danach hast du aber nicht gefragt, darum habe ich es auch nicht eingebaut.
Option Explicit
'Module to send Excel-Sheet directly with outlook
'April 2013 by Klaus M.vdT.
'original Code by mumpel / www.herber.de / 11.04.2013 11:23:25
'https://www.herber.de/forum/messages/1308295.html
'MODIFIZIERT 11/MÄRZ/2014 für Larissa
Sub SendAllx()
'give variables to send-Makro like this!
Dim sSheet As String
Dim sText As String
Dim sTo As String
Dim sSubject As String
Dim sAtt As String
Dim lRow As Long
Dim myRng As Range
With Sheets("Pending")
lRow = .Cells(.Rows.Count, 7).End(xlUp).Row
sSubject = Sheets("NL_Text").Range("A2").Value
sText = Sheets("NL_Text").Range("B2").Value
sAtt = "C:\Artikel.pdf"
'ich nehme an, der Pfad soll C2 aus NL_Text sein? Dann so:
'sAtt = Sheets("NL_Text").Range("C2").Value
'aber bitte in NL_Text den Pfad ohne die "" schreiben!!
For Each myRng In .Range(.Cells(2, 7), .Cells(lRow, 7))
If myRng.Value = "x" Then
sTo = .Cells(myRng.Row, 8).Value
Call SendMailOutlook(sSubject, sTo, sText, sAtt)
End If
Next myRng
End With
End Sub
Private Sub SendMailOutlook(sSubject As String, sTo As String, sText As String, AWS As String)
Dim olApp As Object
Dim olOldBody As String
'Make Email
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
.GetInspector.Display
olOldBody = .htmlBody
.To = sTo
.Subject = sSubject
.htmlBody = sText & olOldBody
.Attachments.Add AWS
End With
End Sub
Grüße,
Klaus M.vdT.