In a previous thread we determined how to use a cell as a reference for a filepath rather than hardcoding the filepath. I wanted to add this same concept to another macro.
In this macro, the code attaches specific workbooks to specific individuals, with the workbooks being pulled from the file path. I referenced the cell as I did in my other code, but it is only attaching one workbook to an email and not attaching the others. I have checked the file path etc.
Note, I commented out the original code that contains the hardcoded file path (this code works). I appreciate any input!
I also did some testing with adding a *\* but that makes the emails not attach anything, without it I am able to attach one.
In this macro, the code attaches specific workbooks to specific individuals, with the workbooks being pulled from the file path. I referenced the cell as I did in my other code, but it is only attaching one workbook to an email and not attaching the others. I have checked the file path etc.
Note, I commented out the original code that contains the hardcoded file path (this code works). I appreciate any input!
I also did some testing with adding a *\* but that makes the emails not attach anything, without it I am able to attach one.
VBA Code:
Sub AttachmentEmails()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim SigString As String
Dim Signature As String
Dim count, i As Integer
Dim attachPath As String
Dim attachDoc As String
'set location of saved Outlook signature
'note it requires the desired signature to be labaled "New"
SigString = Environ("appdata") & "\Microsoft\Signatures\New.htm"
'use custom function (detailed below) to fix image paths in the htm file
Signature = FixHtmlBody(SigString)
'open tracking sheet
Sheets("2021 Email + Tracking").Activate
'determine length of loop
'function counts the number of non-blank rows (starting with header currently in row 7) and adds number of prior rows (currently 6) to get the appropriate final row number
'to customize: replace B7 reference with cell starting the relevant table and replace 6 with the appropriate number of rows (before table header)
count = WorksheetFunction.CountA(Range("B7", Range("B7").End(xlDown))) + 6
'set starting point for loop (should be first row with a name)
i = 8
'start of loop
Do While i <= count
'call on Outlook
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'determine email body
'to customize: enter in desired font and size
'replace "2021 Email + Tracking" with appropriate sheet name (in all locations)
'replace 15 with column number (A = 1, B = 2, etc.) for First Name
'replace 16 with column number for Paragraph 1
'replace 17 with column number for Due Date
'replace 18 with column number for Paragraph 2
'update static text as appropriate using HTML for customizing font presentation or adding links or line spaces.'
'each line must end with "& _" to signify that you have additional text to write. References to Excel cells should be outside of quotes and separated by & to concatenate.
strbody = "<font face =""Calibri"" style = ""font-size:11pt;"">" & _
"Hi " & Sheets("2021 Email + Tracking").Cells(i, 15) & ",<br><br>" & _
Sheets("2021 Email + Tracking").Cells(i, 16) & _
" We ask that you assist us by completing the attached spreadsheet on behalf of you and your direct reports by <font color = ""red""><b>" & Format(Sheets("2021 Email + Tracking").Cells(i, 17), "[$-x-sysdate]dddd, mmmm dd, yyyy") & "</b></font> to ensure that the Model Inventory remains accurate and complete.<br><br>" & _
Sheets("2021 Email + Tracking").Cells(i, 18) & "<br><br>" & _
"Please do not hesitate to reach out with any questions. I am also happy to set up a call to further discuss what we are trying to accomplish with this exercise, or provide more information about the Model Risk Management program in general.<br><br>" & _
"Thank you in advance for your cooperation! <br>"
*******************************************************
'this is the section with the problematic code, the original is not commented out'
'define attachment
'replace 14 with column number of file name
attachPath = "C:\2021 Initial Surveys"
attachDoc = attachPath & "\" & Sheets("2021 Email + Tracking").Cells(i, 14)
'new code test (only attaches one email does not work)
'attachPath = Range("C9").Value
'attachDoc = attachPath & Sheets("2021 Email + Tracking").Cells(i, 14)
'end section'
************************************
On Error Resume Next
With OutMail
'to customize: replace 8 with column corresponding to Scenario, adjust the IF statement to capture desired scenarios/batch;
'__replace 9 with column corresponding to Batch and update "Cover" and Cells(12,3) as necessary.
'replace 10 with column number for To Address
'replace 12 with column number for CC Address
'replace 13 with column number for Subject
If Sheets("2021 Email + Tracking").Cells(i, 8).Value > 0 And Sheets("2021 Email + Tracking").Cells(i, 9).Value = Sheets("Cover").Cells(12, 3).Value Then
.Display
'send to Person 1
.To = Sheets("2021 Email + Tracking").Cells(i, 10)
.CC = Sheets("2021 Email + Tracking").Cells(i, 12)
.Subject = Sheets("2021 Email + Tracking").Cells(i, 13)
.Attachments.Add attachDoc
.HTMLBody = "<html><body>" & strbody & "<br>" & Signature
Else
End If
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
i = i + 1
Loop
End Sub
