09.11.2019, 09:54
(Dieser Beitrag wurde zuletzt bearbeitet: 09.11.2019, 10:40 von WillWissen.
Bearbeitungsgrund: Codetags
)
Hallo ich habe es soweit hinbekommen das ich wenn Termine fällig werden Emails versendet werden.
Diese muss ich aber selber wegschicken wird also nicht automatisch gemacht.
Wie kann ich die Emails automatisch versenden lassen ohne das ich jedesmal die Emails selber versenden muss????
hier mal der Code:
Danke vorab
Diese muss ich aber selber wegschicken wird also nicht automatisch gemacht.
Wie kann ich die Emails automatisch versenden lassen ohne das ich jedesmal die Emails selber versenden muss????
hier mal der Code:
Code:
Public Sub CheckAndSendMail()
'Updated by Extendoffice 2018/11/22
Dim xRgDate As Range
Dim xRgSend As Range
Dim xRgText As Range
Dim xRgDone As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xLastRow As Long
Dim vbCrLf As String
Dim xMailBody As String
Dim xRgDateVal As String
Dim xRgSendVal As String
Dim xMailSubject As String
Dim i As Long
On Error Resume Next
Set xRgDate = Application.InputBox("Please select the due date column:", "KuTools For Excel", , , , , , 8)
If xRgDate Is Nothing Then Exit Sub
Set xRgSend = Application.InputBox("Please select the recipients?email column:", "KuTools For Excel", , , , , , 8)
If xRgSend Is Nothing Then Exit Sub
Set xRgText = Application.InputBox("Select the column with reminded content in your email:", "KuTools For Excel", , , , , , 8)
If xRgText Is Nothing Then Exit Sub
xLastRow = xRgDate.Rows.Count
Set xRgDate = xRgDate(1)
Set xRgSend = xRgSend(1)
Set xRgText = xRgText(1)
Set xOutApp = CreateObject("Outlook.Application")
For i = 1 To xLastRow
xRgDateVal = ""
xRgDateVal = xRgDate.Offset(i - 1).Value
If xRgDateVal <> "" Then
If CDate(xRgDateVal) - Date <= 60 And CDate(xRgDateVal) - Date > 30 Then
xRgSendVal = xRgSend.Offset(i - 1).Value
xMailSubject = xRgText.Offset(i - 1).Value & " l?uft ab " & xRgDateVal
vbCrLf = "<br><br>"
xMailBody = "<HTML><BODY>"
xMailBody = xMailBody & "Hallo " & xRgSendVal & vbCrLf
xMailBody = xMailBody & "VEMAGS-Nummer (Dauer Ingolstadt) l?uft ab " & xRgText.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & "</BODY></HTML>"
Set xMailItem = xOutApp.CreateItem(0)
With xMailItem
.Subject = xMailSubject
.To = xRgSendVal
.HTMLBody = xMailBody
.Display
'.Send
End With
Set xMailItem = Nothing
End If
End If
Next
Set xOutApp = Nothing
End SubDanke vorab
