Benutzerdaten aus Excel per VBA mit Outlook verschicken

[marcodamaster]

Hallo zusammen,

habe mir jetzt schon verschiedene YT Videos über VBA angeguckt und verschiedene Foren durchforstet.
Leider finde ich nicht das, was ich suche...

Ich habe eine Tabelle mit Benutzernamen, Passwörtern und Mailadressen.
                                                                                        

	A	B	C
1	Mailadresse	Benutzername	Passwort
2	a@b.de	abc	def
3	d@hx.de	efg	xyzzy
4	las@vel.de	zyx	12123

...

An Mailadresse: (Daten aus Spalte A)

Es gibt einen festen Betreff: "Benutzerdaten für www.testseite.de"

Und es gibt einen Body mit Variablen:
"Sehr geehrte Damen und Herren,

hier finden Sie Ihre Benutzerdaten und unsere Internetseite.

Benutzername: (Nun soll er die Daten aus Spalte B nehmen)
Passwort: (Daten aus Spalte C)

Unter folgendem Link können Sie sich anmelden: www.testseite.de

Mit freundlichen Grüßen"


Das Makro soll nun Zeile für Zeile abarbeiten.
Ich hoffe mir kann jemand helfen.

Schönen Sonntagabend noch.
Marco

[RPP63]

Moin!
Serienmail (Adressen in Bereich):
http://www.rondebruin.nl/win/s1/outlook/amail6.htm
Wichtig ist hier die Schleife
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'
Next

Zusammensetzen des Bodys:
https://www.rholtz-office.de/outlook/ema...llen_teil1

Auf beiden Sites kannst Du Dich erst mal tummeln, ist ein hervorragender Wissenspool.

Dann entwickelst Du (D)einen Code und stellst ihn zusammen mit Deiner Übungsdatei hier ein, wenn Du noch Probleme hast.

Gruß Ralf

[marcodamaster]

Moin Ralf,

vielen Dank für die Tipps!
Werde bald noch ein richtiger VBA-Profi :19: 


Folgende Fragen habe ich jetzt noch:
- Ich habe im Body keine Formatierung angegeben. Warum ist die erste Zeile größer und in einer anderen Schriftart?
[
Bild bitte so als Datei hochladen: Klick mich!
]

Nun zieht er sich den Benutzername + Passwort immer aus Zelle C1 bzw. D1. Hier soll natürlich auch immer die nächste Zeile verwendet werden.

Hier der benutzte Code:

Code:

Sub Send_Files()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
   Dim OutApp As Object
   Dim OutMail As Object
   Dim sh As Worksheet
   Dim cell As Range
   Dim FileCell As Range
   Dim rng As Range
   Dim olApp     As Object
   Dim AWS       As String
   Dim olOldbody As String

   With Application
       .EnableEvents = False
       .ScreenUpdating = False
   End With

   Set sh = Sheets("Sheet1")

Set olApp = CreateObject("Outlook.Application")

   For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

       'Enter the path/file names in the E:Z column in each row
       Set rng = sh.Cells(cell.Row, 1).Range("E1:Z1")

       If cell.Value Like "?*@?*.?*" And _
          Application.WorksheetFunction.CountA(rng) > 0 Then

   With olApp.CreateItem(0)
               .GetInspector.Display
               olOldbody = .htmlBody
               .To = cell.Value
               .Subject = "Anmeldeinformationen Webshop"
               .htmlBody = "Sehr geehrte Damen und Herren,<br><br>herzlich willkommen in unserem Onlineshop.<br><br>Hiermit erhalten Sie Ihre Zugangsdaten, die Sie ab sofort verwenden können:<br><br>" & _
                         "Benutzername: " & Range("C1") & _
                         "<br>" & _
                         "Passwort: " & Range("D1") & _
                         "<br><br>Sollten Sie Fragen oder Anregungen haben, melden Sie sich doch einfach bei uns!" & _
                         "<br><br>Mit freundlichen Grüßen<br>Marco<br><br>" & olOldbody

               For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                   If Trim(FileCell) <> "" Then
                       If Dir(FileCell.Value) <> "" Then
                           .Attachments.Add FileCell.Value
                       End If
                   End If
               Next FileCell

               .Display  '.Send or .Display
           End With

           Set OutMail = Nothing
       End If
   Next cell

Außerdem im Anhang die benutzte Datei.

Vieleicht kann mir hier ja noch jemand helfen.

Gruß
Marco

[marcodamaster]

Hallo zusammen,

hab es jetzt noch über einen ganz anderen Ansatz versucht zu lösen.

Code:

Option Explicit


Sub BtnEmail_Senden()
   Send_Email
End Sub


Private Sub Send_Email()
   '-------------< Send_Email() >-------------
   Dim sTitle As String
   sTitle = "Anmeldeinformationen Webshop www.plate.de"
   '< 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_Address As String
   Dim iRow As Integer
   For iRow = 2 To 100
       If Cells(iRow, 5) = "x" Then
           '< get Email Address >
           'Column 2, B
           sEmail_Address = Cells(iRow, 1)
       End If
   Next

   Dim sAnrede As String
   Dim iRow2 As Integer
   For iRow2 = 2 To 100
       If Cells(iRow2, 5) = "x" Then
           sAnrede = Cells(iRow2, 4)
       End If
   Next
   
   Dim sBenutzer As String
   Dim iRow3 As Integer
   For iRow3 = 2 To 100
       If Cells(iRow3, 5) = "x" Then
           sBenutzer = Cells(iRow3, 2)
       End If
   Next
           'sPasswort = Cells(iRow, 3)
           '</ get Email Address >
           
           '< Fill Placeholders >
           Dim sHTML As String
           sHTML = Replace(sTemplate, "[@Anrede]", sAnrede)
           'sBenutzer = Replace(sTemplate, "[@Benutzer]", sBenutzer)
           '</ Fill Placeholders >
           
           '--< Send Email >--
           Set objEmail = app_Outlook.CreateItem(olMailItem)
           objEmail.To = sEmail_Address
           objEmail.Subject = sTitle
           'objEmail.HTMLBody = sHTML  '*use .HTMLBody for HTML
           objEmail.Body = sHTML       '*and .body for pure Text
           objEmail.Display True
           'objEmail.Send
           '--</ Send Email >--
                   
     
   
   
   '< Abschluss >
   Set objEmail = Nothing
   Set app_Outlook = Nothing
   '</ Abschluss >
   
   MsgBox "Emails erstellt", vbInformation, "Fertig"
   
   '----</ Send with Outlook >----
   '-------------</ Send_Email() >-------------
End Sub


'---get Text--
'sTemplate = Sheets("ini_Vorlage").Shapes(1).DrawingObject.Text
'sTemplate = Sheets("ini_Vorlage").Shapes(1).TextFrame.Characters.Text
'or sHTML=Sheets("ini_Vorlage").Shapes(1).Textframe.Characters.Text
'.TextRange.Characters.Text

Leider habe ich nun noch das Problem, dass er sich nicht alle Platzhalter zieht bzw. ich auch nicht weiß, wie ich mehrere Platzhalter einbinde.
Es geht um "@Benutzer" und "@Passwort"

Außerdem fehlt mir das wissen um hier noch einen Anhang einzubinden.

Kann da bitte mal jemand rüberschauen.
Datei anbei.

Besten Dank.

[schauan]

Hallöchen,

mit einem Platzhalter funktioniert es ?

Dann eventuell so. Replace kann man verschachteln.

sHTML = Replace(Replace(sTemplate, "[@Anrede]", sAnrede), "[@Benutzer]", sBenutzer)

Allerdings vermute ich, wenn es sich um Bereiche einer Excel-Liste handelt, dass Du die Zeilen / Zellen der Liste schon konkret ansprechen musst.