VBA Outlook mail attachment

PhysicsGeek2022 · Nov 11, 2022

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 · Nov 16, 2022

I see a couple of options...
1) for example you modify the addressee to yourself; it will be a reminder to yourself that there is a strange situation pending
2) or we use the column next to the "sent email date" as a flag: if it's empty then sending is allowed; any text ther means "ignore"
To deal with this second hypotesis, modify this line

VBA Code:

If CDate(rngDValue) - Date < 0 And Date > (SentDt.Cells(x, 1) + 7) and SentDt.Cells(x, 2)=""Then   'MMMmmm

Any text will stop the sending, so you may use it as a memo: "Call Joe", "On a long long holiday", "Check with the boss", "No" (beware that also "Yes" will stop the email), ...

PhysicsGeek2022 · Nov 16, 2022

Anthony47 said:
I see a couple of options...
1) for example you modify the addressee to yourself; it will be a reminder to yourself that there is a strange situation pending
2) or we use the column next to the "sent email date" as a flag: if it's empty then sending is allowed; any text ther means "ignore"
To deal with this second hypotesis, modify this line

VBA Code:

If CDate(rngDValue) - Date < 0 And Date > (SentDt.Cells(x, 1) + 7) and SentDt.Cells(x, 2)=""Then 'MMMmmm

Any text will stop the sending, so you may use it as a memo: "Call Joe", "On a long long holiday", "Check with the boss", "No" (beware that also "Yes" will stop the email), ...

This works great! Now let me ask you: Can I change the font color of the e-mail without having to convert the code to HTML? This is the line i'm looking to change:

l = vbCrLf & "Medical/Health Physics Technologist" & vbCrLf & "LVHN Imaging Physics & Radiation Safety" & vbCrLf & "(P) 484-224-1626"

Anthony47 · Nov 16, 2022

No, this is a plain text email.
To apply formats you have to switch to an html message
It is not difficult, you have to use vba commands to create a string that represents an HTMLBody using html commands
For example this string:
myMsg = "<body>Hello my friend, rush sending me your report or I will be in a bad mood Sicerely yours, 
Medical/Health Physics Technologist LVHN Imaging Physics & Radiation Safety (P) 484-224-1626</body>"

 is the equivalent to vbCrLf
color is an attribute of the tag

Then you will use .HTMLBody = myMsg (instead of .Body = ....)

PhysicsGeek2022 · Jan 18, 2023

Hi Anthony, I'm hoping you get this. So I've been using the code we came up with a few months ago and overall things have been going well. However, I thought we had it set up to be able to send a second reminder e-mail if nothing was received. This doesn't seem to be the case. The code doesn't seem to send a second reminder for some reason. I tried looking at it myself and will continue to do so but I thought maybe you can help me find the error as this is out of my wheelhouse. I had posted the code I am currently using.

VBA Code:

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
Dim SentDt As Range
Set SentDt = Range("V2")
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) + 30) And SentDt.Cells(x, 2) = "" Then
            SentDt.Cells(x, 1) = Date
            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)
               .CC = "pamela.garciabuleje@lvhn.org"
               .Body = strBody
               If Dir(rngAtt.Cells(x, 1).Value) <> "" Then         'Check attachmt exists
                    .Attachments.Add rngAtt.Cells(x, 1).Value
               End If
                '.Send
                .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

Anthony47 · Jan 18, 2023

The macro should send an email when all the following conditions are met:
Column P has a past date; column V contains a date older than 30 days; column Z is empty
Doublecheck that the lines you think should rend a reminder match the above conditions.

If that doesn't switch on the light, add these 2 "Debug.Print" lines in the following positions:

VBA Code:

If rngDValue <> "" Then
        ckCnt = ckCnt + 1
        Debug.Print x, rngDValue, Date, SentDt.Cells(x, 1), "#" & SentDt.Cells(x, 2) & "#"
        If CDate(rngDValue) - Date <= 0 And Date > (SentDt.Cells(x, 1) + 30) And SentDt.Cells(x, 2) = "" Then
            Debug.Print "-----SENT"
            SentDt.Cells(x, 1) = Date
            mSub = rngTxt.Cells(x, 0).Value              'Subj is in column R?

At the end of the macro open the vba "Immediate" window (from vba, typing Contr-g should do the job; or Menu /View /Immediate window), copy ALL what you find there (no confidential info should be there) and share the content with your next message.

PhysicsGeek2022 · Jan 19, 2023

Soooo I think the problem was that I was trying to send the 2nd reminder e-mails before the 30 day time period or I didn't notice the column the date was being dropped in (see below). Regardless, I forgot we had it set up in a 30 day increment. However, once I discovered this I stumbled upon another issue I'm wondering if we can fix.

When I send the 2nd e-mail after the 30 day parameter, the code puts the date in column V and replaces the first reminder date in that column. I am hoping to be able to Keep the first reminder date in Column V and have the second reminder date (if one is sent) placed in column W. However, I'd like to keep all the other codes for column W the same. Just to put a date in there if a second e-mail is sent. Thoughts?

Anthony47 · Jan 19, 2023

You may change the delay before the next reminder modifying that "30" in the above instruction

To keep the reminder dates, lets use column Z and above: add in the corrent code a new If /End If block as follows:

VBA Code:

        If CDate(rngDValue) - Date <= 0 And Date > (SentDt.Cells(X, 1) + 30) And SentDt.Cells(X, 2) = "" Then
       'Add this If /End If block >>>:
            If SentDt.Cells(X, 1).Value <> "" Then
                SentDt.Cells(X, 5).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                SentDt.Cells(X, 1).Copy SentDt.Cells(X, 5)
            End If
            SentDt.Cells(X, 1) = Date
            mSub = rngTxt.Cells(X, 0).Value              'Subj is in column R?

In this way before the new date is inserted in column V, the previus one is saved in col Z, after shifting the Z content to the righ
So the reminder dates are stored (newest to oldest) in V, Z, AA, AB, ...

PhysicsGeek2022 · Jan 24, 2023

Anthony47 said:
You may change the delay before the next reminder modifying that "30" in the above instruction

To keep the reminder dates, lets use column Z and above: add in the corrent code a new If /End If block as follows:

VBA Code:

If CDate(rngDValue) - Date <= 0 And Date > (SentDt.Cells(X, 1) + 30) And SentDt.Cells(X, 2) = "" Then 'Add this If /End If block >>>: If SentDt.Cells(X, 1).Value <> "" Then SentDt.Cells(X, 5).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove SentDt.Cells(X, 1).Copy SentDt.Cells(X, 5) End If SentDt.Cells(X, 1) = Date mSub = rngTxt.Cells(X, 0).Value 'Subj is in column R?

In this way before the new date is inserted in column V, the previus one is saved in col Z, after shifting the Z content to the righ
So the reminder dates are stored (newest to oldest) in V, Z, AA, AB, ...

Thank you. I changed the code a bit to use column W rather than column Z. This is how I adjusted the code:

VBA Code:

 If CDate(rngDValue) - Date <= 0 And Date > (SentDt.Cells(x, 1) + 30) And SentDt.Cells(x, 2) = "" Then
            If SentDt.Cells(x, 1).Value <> "" Then
                SentDt.Cells(x, 2).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                SentDt.Cells(x, 1).Copy SentDt.Cells(x, 2)
            End If

Anthony47 · Jan 25, 2023

If that modification works for you we all are ok (but I remember that we used W for a free note, so I should be suspicious...)

PhysicsGeek2022 · Jan 25, 2023

Anthony47 said:
If that modification works for you we all are ok (but I remember that we used W for a free note, so I should be suspicious...)

This is true and I still want to keep the conditions for W that we had previously. Therefore, if there is already a note in W a second e-mail will not be sent. This should also make it so that when the second e-mail is sent the date will go in W and then a 3rd e-mail will not be sent which is what I want. Appreciate all your help. I'll see if this works next month.

VBA Outlook mail attachment

PhysicsGeek2022

New Member

Anthony47

Well-known Member

Excel Facts

PhysicsGeek2022

New Member

Anthony47

Well-known Member

PhysicsGeek2022

New Member

Anthony47

Well-known Member

PhysicsGeek2022

New Member

Anthony47

Well-known Member

PhysicsGeek2022

New Member

Anthony47

Well-known Member

PhysicsGeek2022

New Member

Similar threads

Forum statistics

Share this page

VBA Outlook mail attachment

New Member

Well-known Member

Excel Facts

New Member

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock