Clever-Excel-Forum

Guten Tag miteinander

Ich habe eine Präsenzliste erstellt mit Makro (Button auf jedem Wochenblatt), mit dem das aktuelle Tabellenblatt als PDF den entsprechenden Mailempfänger sendet.

Nun würde ich gerne das Makro anpassen:

   OutMail.to = (fülle Adressen aus Bereich "Tabellenblatt 'Daten' A22:A27 (soweit Adressen hinterlegt sind))
   OutMail.CC = ""
   OutMail.BCC = ""
   OutMail.Subject = (fülle Text aus Zelle "Tabellenblatt 'Daten' A30")
   OutMail.Body = (fülle Text aus Zellen "Tabellenblatt 'Daten' A33:B45")

Kann mir jemand den richtigen Code nennen?

Danke und Gruss
Thomas

Code:
Sub Chef()

Dim sBlatt As String

 Dim sPdfDateiF5 As String

 Dim OutApp As Object

 Dim OutMail As Object

   ' speichern unter als PDF:

   sPdfDateiF5 = "C:\Präsenzliste.PDF"

   ' speichert das aktuelle Blatt (=ActiveSheet) als PDF

   ActiveSheet.ExportAsFixedFormat _

     Type:=xlTypePDF, _

     Filename:=sPdfDateiF5, _

     Quality:=xlQualityStandard, _

     IncludeDocProperties:=True, _

     IgnorePrintAreas:=False, _

     OpenAfterPublish:=False

   ' Bezug zu Outlook herstellen...

   Set OutApp = CreateObject("Outlook.Application")

   ' ...neue E-Mail erzeugen

   Set OutMail = OutApp.CreateItem(0)

   ' Werte den Eigenschaften zuweisen...

   OutMail.to = "noblesse@noblesse.ch" 'richtige Email-Adresse angeben

   OutMail.CC = ""

   OutMail.BCC = ""

   OutMail.Subject = "Präsenzliste Integration Intensiv"

   OutMail.Body = ""

   ' Anhang hinzufügen:

   OutMail.Attachments.Add sPdfDateiF5

   ' ...und abschicken

   OutMail.Send

   ' Objekte sauber auflösen

   Set OutMail = Nothing

   Set OutApp = Nothing

End Sub

Push

Hallo,

mal ungetestet

Code:
Sub Chef()

Dim sBlatt As String

 Dim sPdfDateiF5 As String

 Dim OutApp As Object

 Dim OutMail As Object

 Dim lngC As Long

   ' speichern unter als PDF:

   sPdfDateiF5 = "C:\Präsenzliste.PDF"

   ' speichert das aktuelle Blatt (=ActiveSheet) als PDF

   ActiveSheet.ExportAsFixedFormat _

     Type:=xlTypePDF, _

     Filename:=sPdfDateiF5, _

     Quality:=xlQualityStandard, _

     IncludeDocProperties:=True, _

     IgnorePrintAreas:=False, _

     OpenAfterPublish:=False

   ' Bezug zu Outlook herstellen...

   Set OutApp = CreateObject("Outlook.Application")

   ' ...neue E-Mail erzeugen

   Set OutMail = OutApp.CreateItem(0)

   ' Werte den Eigenschaften zuweisen...

   For lngC = 22 To 27

     If Worksheets("Daten").Cells(lngC, 1) <> "" Then

       'OutMail.to = "noblesse@noblesse.ch" 'richtige Email-Adresse angeben

       OutMail.to = Worksheets("Daten").Cells(lngC, 1) 'richtige Email-Adresse angeben

       OutMail.CC = ""

       OutMail.BCC = ""

       OutMail.Subject = Worksheets("Daten").Cells(30, 1)

       OutMail.Body = Worksheets("Daten").Cells(33, 1).Resize(13, 2)

       ' Anhang hinzufügen:

       OutMail.Attachments.Add sPdfDateiF5

       ' ...und abschicken

       OutMail.Send

     End If

   Next lng

   ' Objekte sauber auflösen

   Set OutMail = Nothing

   Set OutApp = Nothing

End Sub

Noblesse

WillWissen

Steffl