Forum Discussion
VBA - Attaching Files embedded in a worksheet to an email through VBA
Hi everyone, I'm going to start off by saying I'm brand new to VBA coding. So please bear with me.
I have an excel document that I am using VBA to send out emails based on the data in a worksheet. I have this set up and it works. The problem I have is when I try to Include 8 attachments. The attachments are always the same and never change.
Multiple people use this document and will send emails with the 8 attachments, so I need the files in either a centralized location to store the attachments or somewhere we can all access. I found a youtube tutorial that helped me, It suggested to store the files in a separate worksheet named "HiddenSheet" I was able to add a file in cell A1 of the hidden sheet to attach, but I'm having difficulty attaching all 8 files, which are stored in cells A1:A8. No matter what I've tried, the files are never included as an attachment.
Any help would be great, or any alternate suggestions so that everyone can send an email from the excel.
Below is the code I've made. Again I'm new so I apologize if it's bad. In the code, I have 3 attachment Tests in there:
Test 1 - Using a file path which works but not everyone has access to the same location
Test 2 - Was taking one word document file and embedding it in the HiddenSheet in cell A1 which works but it did not work the same way when trying to do this 8 times.
Test 3 - Taking 8 files, embedding them in the HiddenSheet in cells A1:A8 which does not work.
Sub SaveAsDraft()
'Declare variables
Dim objOutlook As Outlook.Application
Dim objMail As Outlook.MailItem
Dim strTo As String
Dim strCC As String
Dim strSubject As String
Dim strBody As String
Dim strSharedMailbox As String
Dim strEmailAddress As String
Dim attachmentCell As Range
Dim hiddenSheet As Worksheet
Set hiddenSheet = ThisWorkbook.Worksheets("HiddenSheet")
Dim fileToAttach As String
Dim fileType As String
Dim i As Integer
'Attachments as String TEST 1
'Dim strAttachment1 As String
'Dim strAttachment2 As String
'Dim strAttachment3 As String
'Dim strAttachment4 As String
'Dim strAttachment5 As String
'Dim strAttachment6 As String
'Dim strAttachment7 As String
'Dim strAttachment8 As String
'Set variables
strTo = strEmailAddress
strSharedMailbox = "SharedMailbox@_____.com"
strCC = "Boss@____.com; Me@____.com"
strSubject = "This is the subject of the email"
strBody = "This is the body of the email" & " " & "Signed, ________"
'strAttachmentName = "____.docx" ' Name of the attachment <--- TEST 2
'Attachments File paths TEST 1
'strAttachment1 = "C:\___.pdf"
'strAttachment2 = "C:\___.pdf"
'strAttachment3 = "C:\___.pdf"
'strAttachment4 = "C:\___.pdf"
'strAttachment5 = "C:\___.xlsm"
'strAttachment6 = "C:\___.xlsm"
'strAttachment7 = "C:\___.xlsx"
'strAttachment8 = "C:\___.mp4"
'Create an instance of Outlook
Set objOutlook = New Outlook.Application
'Get the email addresses and check cell color
i = 5
Do While Len(ActiveSheet.Cells(i, 22).Value) > 0 ' Check if cell in column V is not empty
' Check cell color
If ActiveSheet.Cells(i, 22).Interior.Color = RGB(255, 255, 0) Then ' RGB(255, 255, 0) represents yellow color
' Set the email address
strEmailAddress = ActiveSheet.Cells(i, 22).Value
'Create a new email
Set objMail = objOutlook.CreateItem(olMailItem)
'Set the email properties
objMail.To = strEmailAddress
objMail.SentOnBehalfOfName = strSharedMailbox
objMail.CC = strCC
objMail.Subject = strSubject
objMail.Body = strBody
' Add the attachments - TEST 3
For Each attachmentCell In hiddenSheet.Range("A1:A8")
If attachmentCell.Value <> "" Then
objMail.Attachments.Add attachmentCell.Value, olByValue
End If
Next attachmentCell
' Save the attachment data to a temporary file <---- TEST 2
'Dim tempFilePath As String
'tempFilePath = "C:\Temp\" & strAttachmentName
'Open tempFilePath For Binary Access Write As #1
'Put #1, , attachmentData
'Close #1
' Add the attachment from the temporary file <---- TEST 2
'objMail.Attachments.Add tempFilePath, olByValue, 1, strAttachmentName
'Add the attachments TEST 1
'objMail.Attachments.Add strAttachment1
'objMail.Attachments.Add strAttachment2
'objMail.Attachments.Add strAttachment3
'objMail.Attachments.Add strAttachment4
'objMail.Attachments.Add strAttachment5
'objMail.Attachments.Add strAttachment6
'objMail.Attachments.Add strAttachment7
'objMail.Attachments.Add strAttachment8
'Draft email
objMail.Close (olSave)
'Close the object
Set objMail = Nothing
End If
'Move to the next row
i = i + 1
Loop
'Show confirmation message to user
MsgBox "Done", vbInformation
End Sub