VBA Outlook mail attachment

[PhysicsGeek2022]

Hi All:

I am creating a spreadsheet that will send automatic email reminders to clients using a VBA Macros code. The code uses outlook. I have created the code and spreadsheet to do everything I'd like except attach individual files and keep my signature in my outlook e-mail. I know it can be done (attach files) as I have attached files this way in a previous version of the code. However, now with this new advanced code I can't get the files to attach. If I add the Attachment.Add function, no e-mail are sent at all. If I take the Attachment.Add function out then my e-mails send fine but without the attachment. I'm hoping someone can help me with this. Below is my code. Thank you!



Public Sub Send_Email_Automatically2()
Dim rngD, rngS, rngT, rngU As Range
Dim ob1, ob2 As Object
Dim LRow, x As Long
Dim l, strbody, rSendValue, mSub As String
On Error Resume Next
Set rngD = Range("P2", Range("p2").End(xlDown))
If rngD Is Nothing Then Exit Sub
Set rngS = Range("I2", Range("i2").End(xlDown))
If rngS Is Nothing Then Exit Sub
Set rngT = Range("S2", Range("s2").End(xlDown))
If rngT Is Nothing Then Exit Sub
Set rngU = Range("U2", Range("u2").End(xlDown))
If rngU Is Nothing Then Exit Sub
strFolder = "X:\Nuclear Medicine\NEW LEAD APRON EXCEL REPORTS\New Lead Apron Logs 11.2022"
LRow = rngD.Rows.Count
Set rngD = rngD(1)
Set rngS = rngS(1)
Set rngT = rngT(1)
Set rngU = rngU(1)
Set ob1 = CreateObject("Outlook.Application")
For x = 1 To LRow
rngDValue = ""
rngDValue = rngD.Offset(x - 1).Value
If rngDValue <> "" Then
If CDate(rngDValue) - Date < 0 Then
rngSValue = rngS.Offset(x - 1).Value
mSub = rngT.Offset(0, -1).Value
l = ""
strbody = ""
strbody = strbody & rngT.Offset(x - 1).Value & l
strbody = strbody
Set ob2 = ob1.CreateItem(0)
With ob2
.Subject = mSub
.To = rngS
.Body = strbody
'.Attachments.Add strFolder & "\" & rngU
.display
End With
Set ob2 = Nothing
End If
End If
Next
Set ob1 = Nothing
End Sub

 

[Anthony47]

It creates the e-mail with the dental van attachment but not the other files or e-mails that should be created

Did you modify only the .attachments.Add line or the complete For x /Next x loop?
You may now remove the line with MsgBox

 

[PhysicsGeek2022]

Did you modify only the .attachments.Add line or the complete For x /Next x loop?
You may now remove the line with MsgBox

I tried both. When I try the complete Fox x/Next x loop I get this message

. However, I understand I need an End Sub after Next X. When I add that it appears the code is working properly. Thank you soo much!

 

[Anthony47]

I understand you got the code doing what you expect; good...
I don't know whether you will decide to test it or not, but let me suggest the following variant

Sub Send_Email_Automatically33()
Dim rngDValue
Dim olApp As Object, olEml As Object
Dim LRow As Long, x As Long
Dim rngD As Range, rngTo As Range, rngTxt As Range, rngAtt As Range
Dim l As String, strBody As String, mSub As String
Dim ckCnt As Long, emCnt As Long
'
Set rngD = Range(Cells(2, "P"), Cells(Rows.Count, "P").End(xlUp))  'Date
If rngD Is Nothing Then Exit Sub
Set rngTo = Range("I2")                                  'To
Set rngTxt = Range("S2")                                 'Text
Set rngAtt = Range("U2")                                 'Attachment
LRow = rngD.Rows.Count
Set olApp = CreateObject("Outlook.Application")
For x = 1 To LRow
    rngDValue = rngD.Cells(x, 1).Value
    If rngDValue <> "" Then
        ckCnt = ckCnt + 1
        If CDate(rngDValue) - Date < 0 Then
            mSub = rngTxt.Cells(x, 0).Value              'Subj is in column R?
            l = vbCrLf & "Medical/Health Physics Technologist" & vbCrLf & "LVHN Imaging Physics & Radiation Safety" & vbCrLf & "(P) 484-224-1626"
            strBody = ""
            strBody = strBody & rngTxt.Cells(x, 1).Value & l
            Set olEml = olApp.CreateItem(0)
            With olEml
               .Subject = mSub
               .To = rngTo.Cells(x, 1)
               .Body = strBody
               If Dir(rngAtt.Cells(x, 1).Value) <> "" Then         'Check attachmt exists
                    .Attachments.Add rngAtt.Cells(x, 1).Value
               End If
               .Display    'or .Send
               emCnt = emCnt + 1
            End With
'            Application.Wait (Now + TimeValue("0:00:01"))         'to be enabled if .Send
            Set olEml = Nothing
            AppActivate Application.Caption         'Focus to excel
        End If
    End If
Next x
Set olApp = Nothing
MsgBox ("Checked: " & ckCnt & vbCrLf & "Emails: " & emCnt)
End Sub

You'll see I used different names for the variables (now it is easier FOR ME to remember what they refers to)
I modified the dims, as each variable need to have its type declared (or they will be "variant" type by default)
I modified the several rngX setting, avoiding redundant instructions
I used rngNN.Cells(x,y) instead of rngNN.Offset to fetch the cell values; this only because I like Cells more than Offset, ha ha
I check that the attachment exists before adding it to email; this because it is tricky to recover an email "with a missing attachment"
At the end of the process, a message informs how many rows have been checked and how many emails have been prepared

You know that you might use .Send instead than .Display, even though .Display is safer as it allows the emails to be supervised before sending them. If you, after a long testing, decide to switch to .Send then I recommand enabling the line Application.Wait to make sure the email enter the sending queue before it get destroyed when olEml is set to Nothing. To enable that line just remove the "apostrophe" at the beginning of the line

HTH...

 

[PhysicsGeek2022]

I understand you got the code doing what you expect; good...
I don't know whether you will decide to test it or not, but let me suggest the following variant

Sub Send_Email_Automatically33()
Dim rngDValue
Dim olApp As Object, olEml As Object
Dim LRow As Long, x As Long
Dim rngD As Range, rngTo As Range, rngTxt As Range, rngAtt As Range
Dim l As String, strBody As String, mSub As String
Dim ckCnt As Long, emCnt As Long
'
Set rngD = Range(Cells(2, "P"), Cells(Rows.Count, "P").End(xlUp))  'Date
If rngD Is Nothing Then Exit Sub
Set rngTo = Range("I2")                                  'To
Set rngTxt = Range("S2")                                 'Text
Set rngAtt = Range("U2")                                 'Attachment
LRow = rngD.Rows.Count
Set olApp = CreateObject("Outlook.Application")
For x = 1 To LRow
    rngDValue = rngD.Cells(x, 1).Value
    If rngDValue <> "" Then
        ckCnt = ckCnt + 1
        If CDate(rngDValue) - Date < 0 Then
            mSub = rngTxt.Cells(x, 0).Value              'Subj is in column R?
            l = vbCrLf & "Medical/Health Physics Technologist" & vbCrLf & "LVHN Imaging Physics & Radiation Safety" & vbCrLf & "(P) 484-224-1626"
            strBody = ""
            strBody = strBody & rngTxt.Cells(x, 1).Value & l
            Set olEml = olApp.CreateItem(0)
            With olEml
               .Subject = mSub
               .To = rngTo.Cells(x, 1)
               .Body = strBody
               If Dir(rngAtt.Cells(x, 1).Value) <> "" Then         'Check attachmt exists
                    .Attachments.Add rngAtt.Cells(x, 1).Value
               End If
               .Display    'or .Send
               emCnt = emCnt + 1
            End With
'            Application.Wait (Now + TimeValue("0:00:01"))         'to be enabled if .Send
            Set olEml = Nothing
            AppActivate Application.Caption         'Focus to excel
        End If
    End If
Next x
Set olApp = Nothing
MsgBox ("Checked: " & ckCnt & vbCrLf & "Emails: " & emCnt)
End Sub

You'll see I used different names for the variables (now it is easier FOR ME to remember what they refers to)
I modified the dims, as each variable need to have its type declared (or they will be "variant" type by default)
I modified the several rngX setting, avoiding redundant instructions
I used rngNN.Cells(x,y) instead of rngNN.Offset to fetch the cell values; this only because I like Cells more than Offset, ha ha
I check that the attachment exists before adding it to email; this because it is tricky to recover an email "with a missing attachment"
At the end of the process, a message informs how many rows have been checked and how many emails have been prepared

You know that you might use .Send instead than .Display, even though .Display is safer as it allows the emails to be supervised before sending them. If you, after a long testing, decide to switch to .Send then I recommand enabling the line Application.Wait to make sure the email enter the sending queue before it get destroyed when olEml is set to Nothing. To enable that line just remove the "apostrophe" at the beginning of the line

HTH...

This code appears to work as well. However, the e-mails are not displayed after the code is run. I only get the message box stating how many lines were checked and how many e-mails have been sent.

In addition, I was thinking maybe creating a column that fills out if the e-mail was already sent. So say call column V "message sent" and if it was sent 'yes' would fill in that cell and also turn green. I am also thinking that we should add a code that will then not send another reminder e-mail if one has already been send (say column V already has yes in the cell). What are your thoughts?

 

[PhysicsGeek2022]

This code appears to work as well. However, the e-mails are not displayed after the code is run. I only get the message box stating how many lines were checked and how many e-mails have been sent.

In addition, I was thinking maybe creating a column that fills out if the e-mail was already sent. So say call column V "message sent" and if it was sent 'yes' would fill in that cell and also turn green. I am also thinking that we should add a code that will then not send another reminder e-mail if one has already been send (say column V already has yes in the cell). What are your thoughts?

by the way, I understand what you did with the new code. It's a little more complicated for me to understand but you explained it well so I appreciate that because it helps me to learn.

 

[PhysicsGeek2022]

by the way, I understand what you did with the new code. It's a little more complicated for me to understand but you explained it well so I appreciate that because it helps me to learn.

Also, please disregard my statement about the e-mails not showing up. They were just hidden behind some other files I had open.

 

[Anthony47]

In addition, I was thinking maybe creating a column that fills out if the e-mail was already sent

My standard suggestion is to use a column to set the date for the email sent. Then in the next XX days a new email is not resent
The area modified:

Set rngAtt = Range("U2")                                 'Attachment
Dim SentDt As Range                                      '+++1 New Dim
Set SentDt = Range("Z2")                                 '+++2 Date Sent reminder
LRow = rngD.Rows.Count
Set olApp = CreateObject("Outlook.Application")
For x = 1 To LRow
    rngDValue = rngD.Cells(x, 1).Value
    If rngDValue <> "" Then
        ckCnt = ckCnt + 1
        If CDate(rngDValue) - Date < 0 And Date > (SentDt.Cells(x, 1) + 7) Then   'MMM
            SentDt.Cells(x, 1) = Date                                             '+++3 New
            mSub = rngTxt.Cells(x, 0).Value              'Subj is in column R?

Three added lines are are marked +++, one modified line is marked MMM
This uses column Z, but you can modify it in line +++2, and set a grace period of 7 days, that you can modify in line MMM

 

[PhysicsGeek2022]

My standard suggestion is to use a column to set the date for the email sent. Then in the next XX days a new email is not resent
The area modified:

Set rngAtt = Range("U2")                                 'Attachment
Dim SentDt As Range                                      '+++1 New Dim
Set SentDt = Range("Z2")                                 '+++2 Date Sent reminder
LRow = rngD.Rows.Count
Set olApp = CreateObject("Outlook.Application")
For x = 1 To LRow
    rngDValue = rngD.Cells(x, 1).Value
    If rngDValue <> "" Then
        ckCnt = ckCnt + 1
        If CDate(rngDValue) - Date < 0 And Date > (SentDt.Cells(x, 1) + 7) Then   'MMM
            SentDt.Cells(x, 1) = Date                                             '+++3 New
            mSub = rngTxt.Cells(x, 0).Value              'Subj is in column R?

Three added lines are are marked +++, one modified line is marked MMM
This uses column Z, but you can modify it in line +++2, and set a grace period of 7 days, that you can modify in line MMM

Thank you so much. Can you explain the 7 day grace period for me? I'm not quite sure I understand.

 

[Anthony47]

I mean that for 7 days after an email has been no new email will be sent, even though the deadline (date in column P) has expired; a new email will be sent on the 8th day, if the date in column P has not been updated in the meantime.
For example: a contract has expired, you send the mail to inform; if in 7 days the contract is still expired, ie it has not been extended, then a new email will be sent

 

[PhysicsGeek2022]

I mean that for 7 days after an email has been no new email will be sent, even though the deadline (date in column P) has expired; a new email will be sent on the 8th day, if the date in column P has not been updated in the meantime.
For example: a contract has expired, you send the mail to inform; if in 7 days the contract is still expired, ie it has not been extended, then a new email will be sent

Ok thank you for that explanation. This raises a questions for me: What if I don't desire an e-mail to be sent again for a specific site/location but wish to send it to all the other sites again that haven't completed the task? For example. I send the 1st reminder the 15th of every month for sites that have a due date in the following month (So send out December reminders on November 15th) and then I send them out again in the middle of December if I haven't received the report by then. However, there is a site that I know has temporarily closed or for some other reason that I know about cannot get me the report so I don't want to send them another e-mail but wish to do it for all the other sites? Maybe to put NA or and X in column V (Or as you wrote it column z). Does that make sense? Is there something that can be done about this? I'm obviously trying to find solutions to problems I can think of before they happen.

Anthony, you have no idea how much I appreciate you.

-Matt