VBA ausgewählte Mail versenden, wenn ein Wert unterschritten

Computer: Software & Programmierung Office Software
#1

Hallo liebe Excelfreunde,

leider muss auch ich zugeben, dass ich mich auf dem Gebiet VBA kaum auskenne. Ich habe hier in den Foren versucht was zu meinem Thema zu finden. Es gibt da einiges, aber eben nicht speziell zu meinem Anliegen. Habe die Hoffnung, dass man mir hier helfen kann.

Meine Mappe Sieht wie folgt aus:

…A…B… …C…D
1…10…Maier…Müller…Mü[email protected]
[email protected]
3…usw…

Ich möchte das wenn in Spalte A Wert kleiner 20 automatisch eine Mail an den zugehörigen Adressaten aus Zelle D gesendet wird. Also in meinen Beispiel entspricht dies eine Mail an „Mü[email protected]“.

Inhalt sollte sein: Lieber Herr Müller (also Name aus C1) der Wert bei Maier (Wert aus B1) liegt bei 10 (also Inhalt aus A1) Stunden. Der Andere (klein) würde so ja vorerst keine benachrichtigung bekommen. Bitte nicht auf diesen Link verweisen https://www.youtube.com/watch?v=i-gvQQ0749Y da ich keinen Serienbrief verwenden möchte. Das hilft mir nicht.

Ich nutze Excel 2010 und Outlook 2010.

Die Werte werden über eine Formel ermittelt. Auch die Mailadressen sollen durch einen SVerweis (oder so) eingepflegt werden, da diese Variabel sind.

Ich hoffe das geht…

VBA und alle anderen Arbeitsschritte sind gewünscht. Also z.B. Was muss auf der VBA Ebene in die Arbeitsmappe, was in Tabelle 1, etc.

Vielen Dank

#2

Hallo strickben1980
folgender Code funktioniert ohne Outlook nur direkt mit dem smtp server:

im Workbook:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If Target.Column = 1 And Selection.Cells.Count = 1 Then
  If Target.Value <= 10 Then
   CDO_Mail_Small_Text_2 (Target.Row)
  End If
 End If
End Sub

ins Modul:

Sub CDO_Mail_Small_Text_2(ycol As Integer)

Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1    ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "your_email_adress"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "your_password"
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    .Update
End With

strbody = "Lieber Herr " & ActiveSheet.Cells(ycol, 3).Value & vbNewLine & vbNewLine & _
          "der Wert bei " & ActiveSheet.Cells(ycol, 2).Value & " liegt bei " & ActiveSheet.Cells(ycol, 1).Value & " Stunden" & vbNewLine & _
          "This is line 2" & vbNewLine & _
          "This is line 3" & vbNewLine & _
          "This is line 4"

With iMsg
    Set .Configuration = iConf
    .To = ActiveSheet.Cells(ycol, 4).Value
    .CC = ""
    .BCC = ""
    ' Note: The reply address is not working if you use this Gmail example
    ' It will use your Gmail address automatic. But you can add this line
    ' to change the reply address
    .ReplyTo = "[email protected]"
    .From = """YourName"" <[email protected]>"
    .Subject = "Important message"
    .TextBody = strbody
    .Send
End With

End Sub

Das Mail Modul kommt von http://www.rondebruin.nl/win/s1/cdo.htm wurde einfach ein wenig durch mich angepasst.

#3

Zweite Möglichkeit mit Outlook:

Sub SendMail(ycol As Integer)
Dim OOutlook As Object
Dim OEmail As Object
Dim strRecipient As String

Set OOutlook = CreateObject("Outlook.Application")
Set OEmail = OOutlook.CreateItem(0)
strRecipient = ActiveSheet.Cells(ycol, 4).Value

'Set Subject
OEmail.Subject = "Test Mail"
'Set Body for mail
OEmail.Body = "Lieber Herr " & ActiveSheet.Cells(ycol, 3).Value & vbNewLine & vbNewLine & _
          "der Wert bei " & ActiveSheet.Cells(ycol, 2).Value & " liegt bei " & ActiveSheet.Cells(ycol, 1).Value & " Stunden" & vbNewLine & _
          "This is line 2" & vbNewLine & _
          "This is line 3" & vbNewLine & _
          "This is line 4"
OEmail.To = strRecipient
OEmail.Send

End Sub

Diesen Code konnte ich nicht testen, da ich kein Outlook mehr verwende :slight_smile:

#4

Diesen Code natürlich ins Modul und mit dem selben Code von oben im Worksheet aufrufen