Microsoft Excel

Herbers Excel/VBA-Archiv

pdf an Serienemails beifügen

Betrifft: pdf an Serienemails beifügen von: Larissa
Geschrieben am: 05.11.2014 11:00:50

Hallo Excelfreunde,

ich habe bereits ein Makro mit dem ich Serienemails erstellen kann.

Jeder Email soll aber noch ein pdf beigefügt werden, dessen Pfad sich in Spalte M(13) befindet. Das Makro ist so programmiert, dass nur Emais generiert werden, wenn ein "x" in Spalte A ist.

Option Explicit

Sub Email_mit_Anhang()
  
  Dim sSheet As String
  Dim sText As String
  Dim sTo As String
  Dim sSubject As String
  
  Dim lRow As Long
  Dim myRng As Range
  
  With ActiveSheet
      lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
      
      sSubject = Sheets("Text").Range("A2").Value 'Betreff
      For Each myRng In .Range(.Cells(2, 1), .Cells(lRow, 1))
          
   If myRng.Value = "x" Then
sTo = .Cells(myRng.Row, 11).Value 'Emailadresse
sText = ""
sText = sText & .Cells(myRng.Row, 6) & "

" 'Anrede sText = sText & Sheets("Text").Range("B2").Value 'Emailtext Call SendMailOutlook(sSubject, sTo, sText) 'verschicken End If Next myRng End With End Sub
Könnt Ihr mir bitte dabei helfen die entsprechenden anhänge in die Emails zu bekommen.

Vielen vielen Dank.
Larissa

  

Betrifft: AW: pdf an Serienemails beifügen von: Rudi Maintaire
Geschrieben am: 05.11.2014 12:50:52

Hallo,

sText = sText & .Cells(myRng.Row, 6) & "" 'Anrede
sText = sText & Sheets("Text").Range("B2").Value 'Emailtext
sAttach = .Cells(myRng.Row, 13)
Call SendMailOutlook(sSubject, sTo, sText, sAttach) 'verschicken
End If
          
      Next myRng
  End With
  
  End Sub

Sub SendMailOutlook(sSubject, sTo, sText, sAttach)
'Code
If sAttach <> "" Then
  .attachments.Add sAttach
End If
'weiterer Code
End Sub
Gruß
Rudi


  

Betrifft: AW: pdf an Serienemails beifügen von: Larissa
Geschrieben am: 06.11.2014 05:32:35

Hallo Rudi,
das hat ganz toll geklappt!!!
Danke für Deine Hilfe.
Lieben Gruß,
Larissa