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]

1) Remove the line On Error Resume Next so you will get notified of any error in the code without pretending all is ok
2) Which information is in column U and what it the content of U2?

 

[PhysicsGeek2022]

1) Remove the line On Error Resume Next so you will get notified of any error in the code without pretending all is ok
2) Which information is in column U and what it the content of U2?

Column U contains the hyperlink/path for the file to attach. I put the file pathway as a hyperlink in column U. The data begins at cell U2.

Thank you!

 

[Anthony47]

Could you show the content of U2? Please use # to replace each character you wish to hide

 

[PhysicsGeek2022]

Could you show the content of U2? Please use # to replace each character you wish to hide

I'm not sure I understand what you mean; I don't have any characters to hide?

 

[Anthony47]

I'm not sure I understand what you mean; I don't have any characters to hide?

So show to us which is the content of cell U2

And did you test what happens after removing line On Error Resume Next?

 

[PhysicsGeek2022]

So show to us which is the content of cell U2

And did you test what happens after removing line On Error Resume Ne

 

[PhysicsGeek2022]

I get two errors depending on what I do after I take the code about Exiting if Error out.


If I put Attachment.Add strFolder & "\" & rngU I get this error

If I put .Attachment.Add strFolder & "\" & rngU I get this error

 

[PhysicsGeek2022]

This is my U column for rngU and hyperlinks start at U2. I appreciate all the help!:

 

[Anthony47]

Ok
Your current code

Set rngU = Range("U2", Range("u2").End(xlDown))                                                '1
'..
strFolder = "X:\Nuclear Medicine\NEW LEAD APRON EXCEL REPORTS\New Lead Apron Logs 11.2022"     '2
'..
'..
Set rngU = rngU(1)                                                                             '3
'..
'..
'..
.Attachment.Add strFolder & "\" & rngU                                                         '4

Since in column U you have the complete path and filename, in line 4 you don't have to use strForder & rngU
In line 3 you destroy the list of attachments and associate to rngU only the first one

So:
-remove lines 2 and 3
-try modifying line 4 to

.Attachment.Add rngU.Cells(X,1)