E-Mail automatisch versenden

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

83 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

E-Mail automatisch versenden

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

83 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread