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.
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.
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
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
