Anmeldecodes aus Tabelle mit VBA verschicken

[Phiant]

Hallo liebes Forum!

  Anmeldecodes_Test.xlsx (Größe: 13,79 KB / Downloads: 3)
Folgender Sachverhalt: Wenn Kunden sich bei meinem Portal anmelden wollen, bekommen Sie dazu einen Code den ich ihnen per Mail zuschicke. Die Liste mit den generierten Codes habe ich angehängt. Ich möchte gerne eine Standardmail an die Kunden versenden, mit einheitlichem Betreff und Mailtext. Die Empfänger gebe ich in Outlook per Hand ein, dazu gibt es vorab keine Liste.

Meinen ersten Ansatz mit den Formeln in Spalte D möchte ich gerne durch VBA ersetzen, um einen vernünftigen Standardtext in Outlook formatieren zu können. Meine VBA Kenntnisse sind noch in den Kinderschuhen. Ich habe bereits ein paar Subs, um HTML-Mails mit korrekter Signatur, Empfänger und Betreff zu erstellen, die ich als Vorlage übernehmen möchte.

Wo brauche ich Hilfe? Ich möchte das an der entsprechenden Stelle im Text der Mail, automatisch der nächste Code aus Spalte B eingesetzt wird, wenn in der Spalte C in der selben Zeile kein X steht. Die X möchte ich weiter händisch eintragen.

Mein Code für die Mails in einer anderen Arbeitsmappe ist bisher:

Code:

Sub Mail_versenden()

Dim objOutlook As Object
Dim objMail As Object

Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With objMail
   .To = ThisWorkbook.Worksheets("...").Range("B6")
   .Subject = ThisWorkbook.Worksheets("...").Range("D6")
   .Attachments.Add Cells(14, 2).Value
   .BodyFormat = 2
  .GetInspector
  .HTMLBody = "<span style='font-family:Calibri;font-size:11.5pt;'>" _
            & "Hallo ...,<br>" _
            & "hallo ...,<br><br>" _
            & "anbei erhaltet Ihr ... .<br><br>" _
            & "Ich wünsche Euch ein schönes Wochenende!<br><br>" _
            & "Liebe Grüße,<br>" _
            & "Phiant</span>" & .HTMLBody
  .Display
   End With

End Sub

Wenn noch Infos zur Hilfestellung gebraucht werden, bitte einfach Fragen!

Vielen Dank vorab und liebe Grüße,
Phiant

[Phiant]

Meine Gedanken gehen in Richtung einer Schleifenlösung bei der geprüft wird, ob in C3 ein "X" steht. Wenn das der Fall ist soll C4 geprüft werden auf das "X", usw.
Ist in der geprüften Zelle, z.B. C5 kein "X", soll die Mail erstellt werden mit einem vordefinierten Text und den Code aus B5 ebenfalls an einer definierten Stelle im Text einsetzen.
Die Schleife soll nach dem Auslösen dieser einen Mail beendet werden.

Klappt das mit einer if-Schleife bzw. wie muss ich die definieren?

[schauan]

Hallöchen,

dann mal zwei, drei Grundlagen. Eine Zelle kannst Du mit Range oder Cells adressieren oder kombiniert.
Range("B6") wäre dann Cells(2, 6)

Cells wird u.a. wegen der Schleifenprogrammierung von Spalten und Zeilen gern genommen.

Schleifen gibt es einige, in Deinem Fall ggf. eine For To mit entsprechendem Zähler.

Oben deklarierst Du eine Schleifenvariable, z.B. Dim iCnt% Prozent ist das Kurzzeichen für Integer, falls das nicht reicht käme als nächstes & bzw. Long
Dann kommt noch die Bedingung, ob in Spalte C kein X steht

Könnte dann im Prinzip so aussehen:

For iCnt = 6 To 66
If Cells(iCnt,3).Value <> "X" Then
'... Dein Code, Statt Range("..") dann Cells(..,..)
End If
Next


Die 66 hab ich jetzt mal so gesetzt. man kann auch die letzte belegte Zelle feststellen und so weit gehen, Das würde ich gleich mal anhand der Spalte C tun, denn wenn kein X mehr kommt kann man ja die Schleife verlassen.

also, statt 66 dann

Cells(Rows.Count, 3).End(xlUp).Row

Das ist praktisch die VBA-Variante für von ganz unten zur letzten belegten Zelle springen (STRG+Up)

[Phiant]

Hi schauan :)

Tatsächlich habe ich mich vorhin noch durch probieren zu einer Lösung vorgearbeitet:

Code:

Sub Mailversand()

Dim objOutlook As Object
Dim objMail As Object
Dim i As Integer

Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

For i = 3 To 55
    If ThisWorkbook.Worksheets("Codes").Cells(i, 3) = "" Then
        With objMail
            .To = ThisWorkbook.Worksheets("Codes").Range("A1")
            .Subject = ThisWorkbook.Worksheets("Codes").Range("G2")
            .BodyFormat = 2
            .GetInspector
            .HTMLBody = "<span style='font-family:Calibri;font-size:11.5pt;'>" _
                      & "Sehr geehrter Mitarbeiter,<br><br>" _
                      & "mit den folgenden Daten erhalten Sie Zugang zu unserem Zusatzkurs " _
                      & Chr(34) & "..." & Chr(34) & ", mit dem Sie sich ... sichern können.<br><br>" _
                      & "<u>Gehen Sie dabei bitte wie folgt vor:</u><br>" _
                      & "<b>1. Link öffnen:</b> " & "<a href=""https://www.test.de"">Test Kurs</a><br>" _
                      & "<b>2. Code eingeben:</b> " & ThisWorkbook.Worksheets("Codes").Cells(i, 2) & "<br><br>" _
                      & "Nach der Code-Eingabe haben Sie 7 Tage Zeit den Kurs zu bearbeiten. Anschließend verfällt ihr Code" _
                      & "und Sie müssen sich einen neuen sichern.<br><br>" _
                      & "Für Rückfragen steht Ihnen ... selbstverständlich gerne zur Verfügung.<br><br>" _
                      & "Viel Erfolg!</span>" & .HTMLBody
            .Display
        End With
        Exit For
    End If
    Next
End Sub

Die Reihenfolge bei End und Exit der einzelnen Funktionen habe ich einfach ausprobiert. Jetzt klappt es, dass nur 1 Mail erstellt wird mit dem 1. Code der noch nicht mit X markiert wurde. Warum das jetzt so funktioniert weiß ich leider nicht ;)

Was ich mir wünschen würde: Sollten alle Codes bereits mit einem x markiert sein, soll eine MsgBox erscheinen die darauf hinweist. Wie kann ich das noch in den Code integrieren? Unter "Next" eine neue "If" mit welcher Bedingung? Es soll nur angezeigt werden, wenn alle Zeilen der Spalte C in der Tabelle ein X enthalten.

[schauan]

Hallöchen,

wenn Du eine feste Anzahl erwartest, kannst Du schon am Anfang prüfen und ggf. das Makro verlassen, z.B.

if WorksheetFunction.CountIf(Range("C2:C55"),"X")=53 then MsgBox "Nix zu tun":Exit Sub

[Phiant]

Sehr gute Idee! Ja die Anzahl der Codes bleibt fest, sind alle verbraucht, wird die selbe Anzahl nachgeschossen :)

Vielen lieben Dank!