Hello all,
I was hoping someone could help with a problem I'm having. I wish to generate a large number of emails from a list in Excel, but also attach specific files to each email. Please see the attached Excel sheet.
In Column A I will have a long list of email addresses, approximately 180, in Column B I have a list of files which should be attached to a specific email, I can't work out how to get the code to loop through the list of attachments, it loops through and creates the emails perfectly well, the main file, in the code listed under the path F:\2017\Sub\Main File Here.docx, must be included in every single email, however a separate Excel sheet should also be included. Eg: email1 = Excel Sheet 1, email2 = Excel Sheet 2, each email will have a differently named excel sheet.
I know it's probably something every simple, I'm just not able to get anything working.......... Getting very frustrated too. Any help will be greatly appreciated.
Sub SendHTMLEmail()
Dim OutlookApp As Object
Dim MItem As Object
Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Recipient As String
Dim Msg As String
'Create Outlook object
Set OutlookApp = CreateObject("Outlook.Application")
'Loop through the list of emails in Column A
For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeVisible)
If cell.Value Like "*@*" Then
EmailAddr = cell.Value
'Create email and view before sending. To automatically send all emails, uncomment the .send line at the end.
Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
'Email Importance. Can be 1 (which is normal), 2 (which is High) or 0 (which is Low).
.Importance = 2
'Read Receipt. Set this to True or False.
.ReadReceiptRequested = True
.To = EmailAddr
.cc = "ourcompanyemailhere"
.Subject = "subject here however long I need"
.HTMLbody = "Dear Sir/Madam," & "<br><br>" & _
"blahdy blahdy blah." & "<br><br>" & _
"moredy moredy more" & "<br><br>" & _
"Kind regards,"
.Attachments.Add ("F:\2017\Sub\Main File Here.docx")
'.Attachments.Add ("variable excel file here")
.Display
'.Send
End With
End If
Next cell
End Sub