Office: VBA-Laienproblem

Hallo liebe Excelianer,

ich habe heute zum allerersten Mal in die VBA-Maske von Microsoft Excel hineingeschnuppert, um mir einen Button zum automatisierten E-Mail-Versand aus Excel zu basteln. Grundsätzlich tut der Code bereits, was er soll: Beim Klick auf den Button öffnet sich ein Outlook-Element mit meinem vorformatierten Text. Auch das Ausfüllen der Platzhalter klappt dabei schon gut.

Allerdings scheitere ich noch an der Falldefinition für den Versand.

Ich habe ein Arbeitsplatz mit 500 Zeilen und über 100 Spalten, das in Zeile 1-2 Rahmendaten und in Zeile 3 verschiedene E-Mail-Adressen enthält. Die Spalten A und B sind ebenfalls mit Rahmendaten befüllt, C enthält Text, der für Platzhalter im Mail-Text eingesetzt wird. In Spalte D stehen abermals Rahmendaten. Alle anderen Zellen (E4:DQ500) können entweder leer oder mit "x" befüllt sein. Ich möchte nun erreichen, dass die E-Mail-Adresse in Zeile 3, sobald eine Zelle oder mehrere Zellen der gleichen Spalte "x" enthält/enthalten, als Empfänger des Outlook-Elements / mehrerer Outlook-Elemente eingesetzt wird - das mag mir als, wie gesagt, absolutem VBA-Neuling, der gestern noch nicht wusste, wie man die Entwicklertools überhaupt nutzt, aber nicht gelingen.

Ich habe eine Beispieldatei angehängt (nicht als xlsm) und meine "Teilerfolge" beziehen sich auf diesen Code:

****
Option Explicit



Sub BtnSend()

Send_Email

End Sub


Private Sub Send_Email()

Dim sTitle As String

sTitle = "Aufgabenerfüllung"


Dim sTemplate As String

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


Dim app_Outlook As Outlook.Application

Set app_Outlook = New Outlook.Application


Dim objEmail As Outlook.MailItem


Dim sEmail_Address As String

Dim iRow As Integer

For iRow = 4 To 10

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

sEmail_Address = Range("G3")



End If



Dim Aufgaben As String

Dim iColumn As Integer

For iColumn = 5 To 10

If Cells(iColumn, 7) = "x" Then

Aufgaben = Cells(iColumn, 3)



Dim sHTML As String

sHTML = Replace(sTemplate, “Aufgabe z”, Aufgabe xy)



Set objEmail = app_Outlook.CreateItem(olMailItem)

objEmail.To = sEmail_Address

objEmail.Subject = sTitle

objEmail.Body = sHTML

objEmail.Display False

'objEmail.Send



End If

Next

Next


Set objEmail = Nothing

Set app_Outlook = Nothing


MsgBox "Alert Mails created", vbInformation, "Done"

End Sub

***

Es hakt mit großer Sicherheit bei den Spalten- und Reihenzuweisungen... aber ich komme leider auf keinen grünen Zweig :/
Ich bin mir sicher, dass der ein oder andere einen eleganteren Code-Aufbau im Kopf hat, würde aber, sofern es irgendwie möglich ist, zunächst gern (nah) bei dieser Struktur bleiben.

 

Hallo Leviathan51,

in der äußeren For-Next-Schleife (iRow) läufst Du nur Spalte 5 durch, aber nicht die übrigen Spalten.
In der inneren Schleife läuft dann alles durcheinander, weil Du iColumns und iRow durcheinanderschmeißt.
zusätzlich ist in der Replace-Anweisung die Variable "Aufgabe xy" verkehrt.

Probier doch mal so:

Code:

Private Sub Send_Email()

Dim sTitle As String
sTitle = "Aufgabenerfüllung"

Dim sTemplate As String
sTemplate = Sheets("Textvorlage").Shapes(1).TextFrame2.TextRange.Text

Dim app_Outlook As Outlook.Application
Set app_Outlook = New Outlook.Application

Dim objEmail As Outlook.MailItem
Dim sEmail_Address As String

Dim iRow As Integer
Dim Aufgaben As String
Dim iColumn As Integer

For iColumn = 5 To 10
    For iRow = 4 To 10
        If Cells(iRow, iColumn) = "x" Then
                sEmail_Address = Cells(3, iColumn)
                Aufgaben = Cells(iRow, 3)
        End If
    Next iRow
Next iColumn

Dim sHTML As String
sHTML = Replace(sTemplate, "Aufgabe z", Aufgabe)

Set objEmail = app_Outlook.CreateItem(olMailItem)
objEmail.To = sEmail_Address
objEmail.Subject = sTitle
objEmail.Body = sHTML
objEmail.Display False
'objEmail.Send

Set objEmail = Nothing
Set app_Outlook = Nothing

MsgBox "Alert Mails created", vbInformation, "Done"

End Sub

Nachdem mir die richtigen Vorlagen fehlen, kann ich es leider nicht testen.

Natürlich kommen dann noch Feinheiten hinzu:

• Mailversand nur bei gefundenem "x" (jetzt wird immer eine Mail erstellt).
• Eine Mail pro Aufgabe oder eine Mail für alle Aufgaben pro Spalte?
• Oder eine Mail pro Aufgabe an alle Mailadressen dieser Aufgabe?

Aber zum weiteren Tüfteln sollte es reichen.

Gruß,
Lutz

 

Hallo Lutz,

vielen lieben Dank für Zeit und Rat. Die meisten der Probleme hat dein Vorschlag sehr gut in den Griff bekommen und die übrigen sind vermutlich in den von dir erwähnten Feinheiten zu suchen. Während zuvor viel zu viele und zu großen Teilen identische E-Mails erstellt wurden, was vermutlich daran lag, dass, wie du schreibst, alles kreuz und quer durcheinander schleifte, wird aktuell unabhängig von der Anzahl der testweisen x-Einträge lediglich eine E-Mail erstellt.

Es sieht so aus, als würde der Code dabei nach dem x mit dem höchsten Spaltenwert suchen. Das Ziel ist, für jedes x eine eigene E-Mail zu erstellen: wenn in F5 und F7 ein x steht sollte der Adressat in F3 also zwei E-Mails mit den jeweils angepassten Informationen aus den Textplatzhaltern (Aufgaben) erhalten (die funktionieren jetzt super :)). Ich versuche mal mein Glück, speichere deinen Code aber vorher guuut ab - danke nochmal!

 

Dann probier doch mal so:

Code:

Private Sub Send_Email()

Dim sTitle As String
Dim sTemplate As String
Dim app_Outlook As Outlook.Application

Dim objEmail As Outlook.MailItem
Dim sEmail_Address As String

Dim iRow As Integer
Dim Aufgaben As String
Dim iColumn As Integer

Dim sHTML As String

sTitle = "Aufgabenerfüllung"
sTemplate = Sheets("Textvorlage").Shapes(1).TextFrame2.TextRange.Text

Set app_Outlook = New Outlook.Application

For iColumn = 5 To 10
    For iRow = 4 To 10
        If Cells(iRow, iColumn) = "x" Then
            sEmail_Address = Cells(3, iColumn)
            Aufgaben = Cells(iRow, 3)

            sHTML = Replace(sTemplate, "Aufgabe z", Aufgabe)
        
            Set objEmail = app_Outlook.CreateItem(olMailItem)
            objEmail.To = sEmail_Address
            objEmail.Subject = sTitle
            objEmail.Body = sHTML
            objEmail.Display False
            'objEmail.Send
            
            Set objEmail = Nothing
            
            MsgBox "Alert Mails created", vbInformation, "Done"
        End If
    Next iRow
Next iColumn

Set app_Outlook = Nothing

End Sub

Ich habe die ganzen Dim's an den Anfang gesetzt (macht man so der Übersichtlichkeit wegen) und die Erstellung der Mails in die innere Schleife. Bei jedem "x" wird jetzt eine Mail mit der Aufgabe an den Adressaten erstellt.

Gruß,
Lutz

 

Hallo nochmal,

Lutz, du bist super! Funktioniert astrein.

Noch einen schönen Tag!