E-Mail automatisch versenden

Tanja · 2020-03-25T08:05:30+00:00

Hallo zusammen, ich habe eine Excel List und benötige jetzt ein VBA wie man ein automatisches E-Mail versendet. Ich möchte gerne, wenn in "Tabelle 1" die Zelle mit dem Namen im Hintergrund grau oder rot aufscheint, dass die E-Mail Adresse der Person von Tabelle 3 verwendet wird. Kann mir hier jemand bitte helfen? Vielen Dank im Voraus! Lg Tanja

Hallo Tanja,
im Prinzip so (In das Modul der Tabelle. Dazu Rechtsklick auf den Tabellenreiter - Code anzeigen):

Option Explicit

Private Sub Worksheet_Calculate()
    Dim objColorCell As Range, objNameCell As Range
    Dim objOutlook As Object, objMail As Object
    Set objOutlook = CreateObject(Class:="Outlook.Application")
    For Each objColorCell In Range(Cells(1, 4), Cells(Rows.Count, 4).End(xlUp))
        With objColorCell.DisplayFormat.Interior
            If .Color = RGB(255, 0, 0) Or .Color = RGB(166, 166, 166) Then
                Set objNameCell = Worksheets("Tabelle3").Columns(1).Find( _
                    What:=objColorCell.Offset(0, 2).Text, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
                If Not objNameCell Is Nothing Then
                    Set objMail = objOutlook.CreateItem(0)
                    With objMail
                        .To = objNameCell.Offset(0, 2).Text
                        .Body = "Hallo" & vbLf & vbLf & "Mailtext" & vbLf & vbLf & "Gruß Tanja"
                        Call .Display
                    End With
                    Set objMail = Nothing
                    Set objNameCell = Nothing
                Else
                    Call MsgBox("Name: " & objColorCell.Offset(0, 2).Text & _
                        " nicht gefunden.", vbExclamation, "Hinweis")
                End If
            End If
        End With
    Next
    Set objOutlook = Nothing
End Sub

ABER, das Makro wird bei jeder Berechnung einer Formel in der Tabelle ausgelöst. Besser wäre es bei der Eingebe eines Wertes der die Färbung hervorruft. Also, wo gibst du was ein um die Färbung auszulösen?
Gruß
Nepumuk

Hallo Tanja,
leider hast du nicht geschrieben in welcher Zelle / Spalte die Eingabe erfolgt und die entsprechende Zelle in Spalte C zu färben. Daher ins Blaue:

Option Explicit

Private Sub Worksheet_Calculate()
    Dim objCell As Range, objNameCell As Range
    Dim objOutlook As Object, objMail As Object
    Set objOutlook = CreateObject(Class:="Outlook.Application")
    For Each objCell In Range(Cells(2, 4), Cells(Rows.Count, 4).End(xlUp))
        With objCell.Offset(0, -1).DisplayFormat.Interior
            If .Color = RGB(255, 0, 0) Or .Color = RGB(231, 230, 230) Then
                Set objNameCell = Worksheets("Einkäufer").Columns(1).Find( _
                    What:=objCell.Text, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
                If Not objNameCell Is Nothing Then
                    Set objMail = objOutlook.CreateItem(0)
                    With objMail
                        .To = objNameCell.Offset(0, 2).Text
                        .Subject = "Betreff"
                        .Body = "Hallo" & vbLf & vbLf & "Mailtext" & vbLf & vbLf & "Gruß Tanja"
                        Call .Display
                    End With
                    Set objMail = Nothing
                    Set objNameCell = Nothing
                Else
                    Call MsgBox("Name: " & objCell.Offset(0, 2).Text & _
                        " nicht gefunden.", vbExclamation, "Hinweis")
                End If
            End If
        End With
    Next
    Set objOutlook = Nothing
End Sub

Gruß
Nepumuk

Forumthread: E-Mail automatisch versenden

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial