ich kenne mich mit VBA Programmierung noch nicht doll aus, habe im Forum ein tolles Makro gefunden, welches mir bei meinem Problem helfen könnte. Das Makro habe ich schon ein wenig angepasst, um es zu testen. Ich bekomme es aber nicht hin, dass meine Vorstellung funktioniert. Ich lasse in der Range ("AJ49:AJ64") E-Mail-Adressen eintragen, wenn sie die Mail bekommen sollen. (1s ist der Eintrag dort vorhanden), durch mehrere Bedingung (Monat,Tag; Makro Uhrzeit mit Vergleich Uhrzeit; usw.) Das Makro müsste so angepasst werden, dass die Mails versendet werden wenn dort die jeweiligen E-Mail-Adresse auftauchen. Steht nichts drin=keine Mail, stehen Einträge drin=dann Eintrag gleich Empfänger und versenden. Range ("AJ49:AJ64")
Bislang funktioniert das Makro nur wenn ich die E-Mail-Adresse nicht durch eine Formel sondern händisch eintrage und das auch nur zu einer konstanten Emailadresse.
Ich bitte nun Hilfe um dieses Problem zu lösen.
Option Explicit
'----- Setup >------
Private Const °Input_ As String = "a.a@muster.com*"
Private Const °Email_Address_To As String = "a.a@muster.com"
Private Const °Email_Title As String = "Text"
Private Const °Email_Text As String = "hier steht ein Text "
'-----------
'================== Events >==================
Private Sub Worksheet_Change(ByVal Target As Range)
'-------- Worksheet_Change(ImputCell) >--------
'*After_Cell_Input_Change
If Not Intersect(Target, Range("AJ49:AJ64")) Is Nothing Then
If Target.Value Like °Input_ Then
Dim sText As String
sText = °Email_Text
sText = sText & vbCrLf & "Eingabewert =" & Target.Value & " in Zeile: " & Target.Address
Send_Email (sText)
End If
End If
'----------------
End Sub
'====================================
'================== Functions >==================
Private Sub Send_Email(ByVal sText As String)
'------------- Send_Email() >-------------
'---- Send with Outlook >----
Dim app_Outlook As Outlook.Application
Set app_Outlook = New Outlook.Application
'-- Email einstellen >--
Dim objEmail As Outlook.MailItem
'-- Send Email >--
Set objEmail = app_Outlook.CreateItem(olMailItem)
objEmail.To = °Email_Address_To
objEmail.Subject = °Email_Title
objEmail.Body = sText
objEmail.Display False
objEmail.Send '*optional
'----
' Abschluss >
Set objEmail = Nothing
Set app_Outlook = Nothing
'
'--------
'--------------------------
End Sub
'====================================