möchte mehrere Mailadressen einfügen

Sub sendmail() Dim sBlatt As String Dim sPdfDateiF5 As String Dim OutApp As Object Dim OutMail As Object ' speichern unter als PDF: sPdfDateiF5 = "D:\" & "Transportverzögerung" & ".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 = "klausmende58@gmail.com" OutMail.CC = "" OutMail.BCC = "" OutMail.Subject = Range("A29") & Range("k29") OutMail.Body = Range("J118") & Range("J120") & Range("J123") & Range("J125") ' Anhang hinzufügen: OutMail.Attachments.Add sPdfDateiF5 ' ...und abschicken 'OutMail.Send .Display ' Objekte sauber auflösen Set OutMail = Nothing Set OutApp = Nothing ' Tabelle schließen ' Application.DisplayAlerts = True 'Application.Quit End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Klaus,
hier mal ein angepasstes Beispiel. Vielleicht ist es das, was Du möchtest:

Sub sendmail()
   Dim sBlatt As String
   Dim sPdfDateiF5 As String
   Dim OutApp As Object
   Dim Wsh As Worksheet
   Set Wsh = ActiveSheet
'Set WSh=Sheets(sBlatt)
   ' speichern unter als PDF:
   sPdfDateiF5 = "D:\" & "Transportverzögerung" & ".PDF"

   ' speichert das aktuelle Blatt (=ActiveSheet) als PDF
   ActiveSheet.ExportAsFixedFormat _
      Type:=xlTypePDF, _
      Filename:=sPdfDateiF5, _
      Quality:=xlQualityStandard, _
      IncludeDocProperties:=True, _
      IgnorePrintAreas:=False, _
      OpenAfterPublish:=False
   ' ...neue E-Mail erzeugen
   With CreateObject("Outlook.Application").CreateItem(0)
   ' Werte den Eigenschaften zuweisen...
   .To = Wsh.Range("L11").Value & ";" & Wsh.Range("AJ14").Value & ";" & Wsh.Range("AL24").Value
   .CC = ""
   .BCC = ""
   .Subject = Wsh.Range("A29") & " " & Wsh.Range("k29")
   .Body = Wsh.Range("J118") & Wsh.Range("J120") & Wsh.Range("J123") & Wsh.Range("J125")
   ' Anhang hinzufügen:
   If sPdfDateiF5 &LT;&GT; "" Then .Attachments.Add sPdfDateiF5

   ' ...und abschicken
   'OutMail.Send
   .Display
   End With

   ' Objekte sauber auflösen
   Set Wsh = Nothing

   ' Tabelle schließen
' Application.DisplayAlerts = True
   'Application.Quit
End Sub

Da ich Deine Datei nicht habe, hängt es aber auch davon ab, was Du in den einzelnen Feldern stehen hast.
VG
Karl-Heinz

Hallo Klaus,
k.A. warum es dort stehen bleibt. Aber bei vielen Adressen solltest Du ggf. doch die in meiner ersten mail vorgeschlagene Schleife verwenden:

Sub sendmail()
    Dim sBlatt As String
    Dim sPdfDateiF5 As String
    Dim OutApp As Object
    Dim WSh As Worksheet
    Dim Item As Range, Items As String

    Set WSh = ActiveSheet

'Set WSh=Sheets(sBlatt)
    ' speichern unter als PDF:
    sPdfDateiF5 = "D:\" & "Transportverzögerung" & ".PDF"

    ' speichert das aktuelle Blatt (=ActiveSheet) als PDF
    WSh.ExportAsFixedFormat _
       Type:=xlTypePDF, _
       Filename:=sPdfDateiF5, _
       Quality:=xlQualityStandard, _
       IncludeDocProperties:=True, _
       IgnorePrintAreas:=False, _
       OpenAfterPublish:=False
    ' ...neue E-Mail erzeugen
    With CreateObject("Outlook.Application").CreateItem(0)
    ' Werte den Eigenschaften zuweisen...
      For Each Item In Range("$BZ10:$BZ19")
         If Item.Value &LT;&GT; "" Then Items = Items & Item.Value & ";"
      Next Item
      If Items &LT;&GT; "" Then Items = Left$(Items, Len(Items) - 1)
      .To = WSh.Range("L11").Value & ";" & WSh.Range("AJ14").Value & ";" & WSh.Range("AL24").Value & ";" & Items
      .CC = ""
      .BCC = ""
      .Subject = WSh.Range("A29") & " " & WSh.Range("k29")
      .Body = WSh.Range("J118") & WSh.Range("J120") & WSh.Range("J123") & WSh.Range("J125")
    ' Anhang hinzufügen:
      If sPdfDateiF5 &LT;&GT; "" Then .Attachments.Add sPdfDateiF5

    ' ...und abschicken
    'OutMail.Send
      .Display
    End With

    ' Objekte sauber auflösen
    Set WSh = Nothing

    ' Tabelle schließen
   ' Application.DisplayAlerts = True
    'Application.Quit
End Sub

viele Grüße
Karl-Heinz

For Each Item In WSh.Range("$L11,$AJ14,$AL24,$BU10:$BU34") If Item.Value &LT;&GT; "" Then Items = Items & Item.Value & ";" Next Item If Items &LT;&GT; "" Then Items = Left$(Items, Len(Items) - 1) .To = Items .CC = "" .BCC = "" VBA=>HTML, (c) 2018 by KHV

Sub sendmail() Dim sPdfDateiF5 As String, strAdresse As String Dim OutApp As Object, OutMail As Object, loLetzte As Long, i As Long ' speichern unter als PDF: sPdfDateiF5 = "D:\" & "Transportverzögerung" & ".PDF" ' speichert das aktuelle Blatt (=ActiveSheet) als PDF ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPdfDateiF5, _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ OpenAfterPublish:=False ' letzte belegte Zelle in Spalte BU ermitteln loLetzte = Cells(Rows.Count, 73).End(xlUp).Row ' Schleife BU10 bis BU letzte belegte Zelle For i = 10 To loLetzte ' Variable mit Mailadressen füllen If Cells(i, 73) "" Then If strAdresse = "" Then strAdresse = Cells(i, 73) Else strAdresse = strAdresse & ";" & Cells(i, 73) End If End If Next i ' Bezug zu Outlook herstellen... Set OutApp = CreateObject("Outlook.Application") ' ...neue E-Mail erzeugen Set OutMail = OutApp.CreateItem(0) ' Werte den Eigenschaften zuweisen... OutMail.to = strAdresse OutMail.CC = "" OutMail.BCC = "" OutMail.Subject = Range("A29") & Range("k29") OutMail.Body = Range("J118") & Range("J120") & Range("J123") & Range("J125") ' Anhang hinzufügen: OutMail.Attachments.Add sPdfDateiF5 ' ...und abschicken 'OutMail.Send .Display ' Objekte sauber auflösen Set OutMail = Nothing: Set OutApp = Nothing ' Tabelle schließen ' Application.DisplayAlerts = True 'Application.Quit End Sub

Beliebteste Forumthreads (12 Monate)

möchte mehrere Mailadressen einfügen

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

möchte mehrere Mailadressen einfügen

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread