I have set up a Userform which saves data to the Incident Details data sheet and also saves data temporarily to a worksheet called 'Email Form' and laid out like a form so that the 'email form' is copied into the body of a MS Outlook email.
This works perfectly, and with the current coding I was provided sends one email To 1 recipient and CC'd to another, but I need to send same email to multiple recipients. I have created another sheet called ‘Email Recipient List (same workbook) because I want it to be easy to update the lists as required (none of the users would be able to edit the hardcode in VBA). Column A has a list of TO recipients and Column B has a list of CC recipients.
I have searched and view several videos and sites, but I have been unable to workout how to extract the respective lists from the ‘Email Recipient List’ sheet and populate the Outlook email without it affecting the existing actions. I don't want a macro button for users to click because the code opens up the Outlook email.
This is my existing code:
Sub log_send_reset()
'THIS OPENS OUTLOOK WITH DETAILS OF FORM
'WORKS with "Email Form"
Dim SecIncNo As String
'This bit emails the current worksheet in the body of an email as HTML
'#If 0 Then
Dim g As Range
Dim OutApp As Object
Dim OutMail As Object
Set g = Nothing
On Error Resume Next
Set g = Sheets("Email Form").Range("A1:AB119")
On Error GoTo 0
With Application
.EnableEvents = False
.ScreenUpdating = True 'ShyButterfly set this to TRUE (it was false)
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
'This bit tells it where to send the email to, what the subject line is etc
.to = "[email protected]"
.CC = "[email protected]"
.BCC = ""
.Subject = Range("H6").value & " - " & "SAC" & Range("G12").value & " - " & Range("G14").value & " - " & Range("H8").value
.HTMLBody = RangetoHTML(g)
'Shybutterfly changed from.Send to .Display to see what it does
.Display
'or use .Display if you want to edit / add text before sending
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
ThisWorkbook.Save
'ThisWorkbook.Close
'Application.Quit
End Sub
I'd appreciate any assistance.