Collapse column

Autor Thema: VBA Programmierung automatischer Email Versandt  (Gelesen 249 mal)

Offline fatih1995

  • Newbie
  • *
  • Beiträge: 1
    • Profil anzeigen
  • Office-KnowHow: Amateur
  • VBA-KnowHow- : Wenig
  • Version [Office] : Office 2016
VBA Programmierung automatischer Email Versandt
« am: März 25, 2019, 03:16:07 Vormittag »
Hallo ich hoffe Ihr könnt mir helfen :/

Folgendes Problem: Wenn ich die Mail versende, öffnen sich für jede Zeile eine extra Email und leider auch nur jeweils ein Empfänger und einer in cc.

Was muss ich nun in der Programmierung hinzufügen, um nur eine Email geöffnet zu bekommen, mit mehreren Empfängern (Falls mehrere Kreuze gesetzt worden sind). Ich danke euch echt wenn Ihr mir helfen können :/

Ich habe mir die Bausteine aus dem Internet zusammengesetzt, bin daher kein Profi darin.

Programmtext:

Private Sub Send_Email()

   '-------------< Send_Email() >-------------

   Dim sTitle As String

   sTitle = "Test-HTML Email from Excel"

   '< HMTL holen >

   Dim sTemplate As String

   sTemplate = Sheets("ini_Vorlage").Shapes(1).TextFrame2.TextRange.Text

   '</ HMTL holen >

   '----< Send with Outlook >----

   Dim app_Outlook As Outlook.Application

   Set app_Outlook = New Outlook.Application

   '--< Email einstellen >--

   Dim objEmail As Outlook.MailItem

   Dim sEmail_Addresscc As String

   Dim sEmail_Address As String

   Dim iRow As Integer

   For iRow = 4 To 100

       If Cells(iRow, 21) = "x" Then

           '< get Email Address >

           'Column 2, B

           sEmail_Address = Cells(iRow, 19)

           sEmail_Addresscc = Cells(iRow, 20)

           '</ get Email Address >

           '< Fill Placeholders >

           Dim sHTML As String

           sHTML = Replace(sTemplate, "[@Name]", sEmail_Address)

           '</ Fill Placeholders >

           '--< Send Email >--

           Set objEmail = app_Outlook.CreateItem(olMailItem)

           objEmail.To = sEmail_Address

           objEmail.CC = sEmail_Addresscc

           objEmail.Subject = sTitle

           'objEmail.HTMLBody = sHTML 'use .HTMLBody for HTML

           objEmail.Body = sHTML      'and .body for pure Text

           objEmail.Display

           '--</ Send Email >--

       End If

   Next

   '< Abschluss >

   Set objEmail = Nothing

   Set app_Outlook = Nothing

   '</ Abschluss >

   MsgBox "Emails erstellt", vbInformation, "Fertig"

   '----</ Send with Outlook >----

   '-------------</ Send_Email() >-------------

End Sub

Keine Lösung gefunden? Du kannst Dich gerne an unser erfahrenes Experten-Team wenden und Dein Anliegen in Auftrag geben.
>>> Schnell und einfach ein unverbindliches Angebot anfordern. Per E-Mail an anfrage@excel-inside.de oder per Online-Formular
<<<

!!! Wichtige Information
!!! Dieses Forum kann aus technischen Gründen leider nur bis maximal September 2019 in der Form betrieben werden.
Das neue Forum steht bereits unter https://forum.excel-inside.de uneingeschränkt zur Verfügung. Es wird empfohlen, neue Fragen direkt dort zu posten.

Bitte verwendet somit schnellstmöglich das neue Forum - Vielen Dank für euere Unterstützung