I am sorry for the inconvinience. I am new to this site and was hoping to find someone who could help me with this trouble.
I’m trying to make a macro that would automatically send and email when there is 20 days left to the duedate. This macro would have to run 24/7 (or at least while the pc is on)
[TABLE=”width: 625″]
[TR]
[TD]The document should be as simple as this
[TABLE=”width: 537″]
[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]PERSONAL[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]full name[/TD]
[TD]ID[/TD]
[TD]medical exam[/TD]
[TD]due date[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]first person[/TD]
[TD]35834800[/TD]
[TD]01/10/2017[/TD]
[TD]01/10/2018[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]second person[/TD]
[TD]36987452[/TD]
[TD]25/09/2017[/TD]
[TD]25/09/2018[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]etc[/TD]
[TD]36859500[/TD]
[TD]20/09/2017[/TD]
[TD]20/09/2018[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]etc[/TD]
[TD]25478544[/TD]
[TD]30/09/2017[/TD]
[TD]30/09/2018
[/TD]
[/TR]
[/TABLE]
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[/TABLE]
So far I could get this:
Public Sub CheckAndSendMail() Dim Duedate As Range Dim Text 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 DuedateVal As String Dim xRgSendVal As String Dim xMailSubject As String Dim i As Long On Error Resume Next Set Duedate = Range(“D4:D4”) If Duedate Is Nothing Then Exit Sub Set Text = Range(“A4:A7”) If Texto Is Nothing Then Exit Sub xLastRow = Duedate.Rows.Count Set Duedate = Duedate(1) Set Text = Text(1) Set xOutApp = CreateObject(“Outlook.Application”) For i = 1 To xLastRow DuedateVal = Duedate.Offset(i – 1).Value If CDate(DuedateVal) – Date 0 Then xMailSubject = ” Duedate Ref. ” & Texto.Offset(i – 1).Value vbCrLf = “
” xMailBody = “” xMailBody = xMailBody & “text” & Texto.Offset(i – 1).Value xMailBody = xMailBody & ” text” & DuedateVal & “.” xMailBody = xMailBody & “” Set xMailItem = xOutApp.CreateItem(0) With xMailItem .Subject = xMailSubject .To = “testexell@outlook.com” .HTMLBody = xMailBody .Display ‘.Send End With Set xMailItem = Nothing End If Next Set xOutApp = Nothing End Sub
I know I must somehow be able to extend the range (D4:D4) but it would keep sending emails with the blank cells. And when I rerun the macro the mails would be sent again and again. cant figure how to cut the loop.
Can anyone help me?
Thank you in advance for your time if you read and answer me.