MMM13
08-16-2017, 07:00 AM
Hi,
Newbie here.
I have the below code which works great as it is. In the code, the message that is meant for the email is written in HTML in the VBA code. I am trying to now change the code so the email body is taken from a word document. As well as this feature, I am also trying to use a Word Document Object or a textbox within Excel to compose the body and use it in the email, via a macro. Another feature that I would also like to implement would be to add attachments to the email via Excel VBA code.
Every guidance appreciated.
Thank you in advance!
Sub Send_Files()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
Dim strbody
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("TestingSheet") 'Use "TestingSheet" for actual tests, "Test" for actually sending the emails
Set OutApp = CreateObject("Outlook.Application")
strbody = "<HTML>Hi, <br /><br />"
strbody = strbody & "<br /><br />"
strbody = strbody & "<br /><br />"
strbody = strbody & "br /><br />"
strbody = strbody & "<br /><br />"
strbody = strbody & ".<br /><br />"
strbody = strbody & "br /><br />"
strbody = strbody & ".<br /><br />"
strbody = strbody & ".<br /><br /> "
strbody = strbody & "Kind Regards,<br /><br />"
strbody = strbody & "</html>"
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row/
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.BodyFormat = olFormatHTML
.To = cell.Value
.Subject = "Information Governance Training"
.HTMLbody = strbody
.SendUsingAccount = OutApp.Session.Accounts.Item(1)
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
'.Display
.Send
End With
End If
Set OutMail = Nothing
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Newbie here.
I have the below code which works great as it is. In the code, the message that is meant for the email is written in HTML in the VBA code. I am trying to now change the code so the email body is taken from a word document. As well as this feature, I am also trying to use a Word Document Object or a textbox within Excel to compose the body and use it in the email, via a macro. Another feature that I would also like to implement would be to add attachments to the email via Excel VBA code.
Every guidance appreciated.
Thank you in advance!
Sub Send_Files()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
Dim strbody
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("TestingSheet") 'Use "TestingSheet" for actual tests, "Test" for actually sending the emails
Set OutApp = CreateObject("Outlook.Application")
strbody = "<HTML>Hi, <br /><br />"
strbody = strbody & "<br /><br />"
strbody = strbody & "<br /><br />"
strbody = strbody & "br /><br />"
strbody = strbody & "<br /><br />"
strbody = strbody & ".<br /><br />"
strbody = strbody & "br /><br />"
strbody = strbody & ".<br /><br />"
strbody = strbody & ".<br /><br /> "
strbody = strbody & "Kind Regards,<br /><br />"
strbody = strbody & "</html>"
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row/
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.BodyFormat = olFormatHTML
.To = cell.Value
.Subject = "Information Governance Training"
.HTMLbody = strbody
.SendUsingAccount = OutApp.Session.Accounts.Item(1)
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
'.Display
.Send
End With
End If
Set OutMail = Nothing
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub