Good Morning, I have a macro that I'm adapting to send a range of reminders out of an Excel sheet. I'm trying to attach a file and I've never had any issues before but with this one, I get an error operation failed and I can't see where the problem is. The file I'm attaching is on a shared drive. But have put a test.docx on my desktop and tried that and still get the same error. The rest of the code works fine, i.e. if I convert the Add.Attachment line into a comment, the code runs through. I've also inserted a message box with the file coordinates and they seem fine to me.
The file name has 2 variables: the project folder and the file name as these will vary for each project. - B5 contains the path for the project folder and B1 the project name.
I have to admit that even though I have done a number of macros, I consider myself quite pedestrian with VBA. I'm hoping somebody will see where the code goes wrong.
Thanks!
Christine, Auckland
Public Sub SendMeetingMinutes()
Dim OutApp As Object
Dim OutMail As Object
Dim objMail As Object
Dim strSMS As String
Dim strTenderName As String
Dim strDescription As String
Dim strDueDate As String
Dim strTenderFolder As String
Dim strDescription_find As String
Dim strDueDate_find As String
Dim strTenderFolder_find As String
Dim strDescription_replace As String
Dim strDueDate_replace As String
Dim strTenderFolder_replace As String
Dim strTenderPath As String
Dim strContentDue As String
Dim strAM As String
Dim strAttachment As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'Your Sheet names need to be correct in here
Set sh1 = Sheets("TenderData")
Set sh2 = Sheets("MeetingInfo")
Set sh3 = Sheets("TenderTeam")
Dim TemplatePath As String
TemplatePath = "C:\Users\z003uc4z\Documents\Templates\Tender\"
Set objMail = OutApp.CreateItemFromTemplate(TemplatePath + "SMS - xx Tender Kick-Off Meeting Minutes .oft")
On Error GoTo cleanup
strTenderName = sh1.[B1] & sh1.[C8]
strContentDue = Format(sh1.[B13], "dddd, d mmmm YYYY")
strDueDate = Format(sh1.[B12], "dddd, d mmmm YYYY")
strTenderFolder = "<A HREF=""" & sh1.[B5].Value & """>Click here to access folder location.</A>"
strAM = sh1.[B6]
MsgBox sh1.[B5].Value & "\Meetings\Kick-Off Meeting Minutes - " & sh1.[B1].Value & ".pdf"
strAttachment = sh1.[B5].Value & "\Meetings\Kick-Off Meeting Minutes - " & sh1.[B1].Value & ".pdf"
Dim myRange As Range
Dim myEmail As String
lastrow = sh3.Cells(Rows.Count, 1).End(xlUp).Row 'counts the number of rows in use
For Each myRange In sh3.Range("A1:A" & lastrow)
If myRange = "x" Then
myEmail = myEmail & myRange.Offset(0, 3).Value & ";"
End If
Next myRange
'Send Email
With objMail
strDescription_find = "phDescription"
strDescription_replace = sh1.[C8].Value
strContentDue_find = "phContentDue"
strContentDue_replace = strContentDue
strTenderFolder_find = "phTenderFolder"
strTenderFolder_replace = strTenderFolder
strAM_find = "phAM"
strAM_replace = strAM
.To = myEmail
.CC = ""
.BCC = ""
.Subject = sh1.[B1].Value & " - " & sh1.[C8].Value & " Tender *** Kick-off Meeting Minutes ***"
.Attachments.Add = strAttachment
.HTMLBody = Replace(objMail.HTMLBody, strDescription_find, strDescription_replace)
.HTMLBody = Replace(objMail.HTMLBody, strContentDue_find, strContentDue_replace)
.HTMLBody = Replace(objMail.HTMLBody, strTenderFolder_find, strTenderFolder_replace)
.HTMLBody = Replace(objMail.HTMLBody, strAM_find, strAM_replace)
.Display 'or use .Send
End With
Set objMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
MsgBox Err.Description
Exit Sub
End Sub