AW: Mail versenden
08.11.2024 13:12:41
UweD
Hallo
du könntest es so lösen
Das Datum wird per Formel temporär in eine Zelle gelesen und ausgewertet
Sub Datum_check()
Dim Pfad As String, Datei As String, TB As String, QZelle As String, ZZelle As String
Dim Datum As Date
Dim mAtt As String, mBody As String, mSub As String, mTo As String, mCc As String
Pfad = "E:\Excel\Temp\" 'mit \ am Ende
Datei = "AAA.xlsx"
TB = "Tabelle1"
QZelle = "$B$5" 'Beispiel
ZZelle = "$A$1" 'Zielzelle
With Range(ZZelle)
.Formula = "='" & Pfad & "[" & Datei & "]" & TB & "'!" & QZelle
If .Value - Date = 7 Then
mAtt = Pfad & Datei
mBody = "Sehr geehrte Damen und Herren, ...."
mSub = "Achtung Datum kritisch"
mTo = "Ich@Firma.com"
mCc = "Du@Firma.com"
Call SendeMail(mAtt, mBody, mSub, mTo, mCc)
End If
.ClearContents
End With
End Sub
Sub SendeMail(mAtt, mBody, mSub, mTo, mCc)
Dim olApp, objNachricht, objRecipient, objAttachments
Set olApp = CreateObject("Outlook.Application")
Set objNachricht = olApp.CreateItem(0)
Set objAttachments = objNachricht.Attachments
With objNachricht
.Attachments.Add mAtt
.Subject = mSub
.htmlBody = mBody
Set objRecipient = .Recipients.Add(mTo)
objRecipient.Type = 1
If mCc > "" Then
Set objRecipient = .Recipients.Add(mCc)
objRecipient.Type = 2
End If
.DeleteAfterSubmit = True
.Importance = 2 'olImportanceHigh
.Display
End With
'Bereinigung der Variablen
Set objRecipient = Nothing
Set objNachricht = Nothing
Set olApp = Nothing
End Sub
LG UweD