Send Email from VBA to Multiple Emails

[weaselmcguff]

I am trying to send an email to multiple people via VBA.
2 emails are standard and they will be in the .CC line.

an additonal email is from a selection the user makes pertaining to Zone. And the 4th email is from the auditor. These last 2 I have created the lookup and they work fine.

I cant seem to get this to work to send to multiple people on 1 line. Here is my code any help is greatly appreciated

Thanks

Private Sub CommandButton72_Click()
Dim date2 As String ' Date field
Dim email2 As String ' Who Email is Going To
Dim N1 As String ' Name Field
Dim subject1 As String ' What the email is about
Dim ccemail As String 'Inspectors email
Sheets("Teams").Select ' targets Office worksheet
ccemail = WorksheetFunction.VLookup(cbauditor2, Range("B31:D34"), 3, 0) 'returns email address
date2 = Worksheets("Office").Range("B3").Value ' Date
Worksheets("Office").Range("B2").Value = cbozone 'zone
Sheets("Teams").Select ' targets Office worksheet
email2 = WorksheetFunction.VLookup(cbozone, Range("A5:D28"), 4, 0) 'returns email address
With OutMail
If email2 = "" Then
email2 = Application.InputBox("Please enter Email To Automatically Email this To:")
Worksheets("Office").Range("E4").Value = email2
Else
'.To = email2 ' who email is going to
.CC = Array(ccemail, "joe.king@email.com") ' facilatator
.Subject = subject1 ' What the Email is about
.Attachments.Add ActiveWorkbook.FullName
.Body = ActiveSheet.Value
.Send
End If
End With
End Sub

Any suggestions are greatly appreciated

Thanks for your time

 

[AlphaFrog]

I'm not sure I follow what you are asking...

Private Sub CommandButton72_Click()

    Dim date2  As String    ' Date field
    Dim email2 As String    ' Who Email is Going To
    Dim N1     As String    ' Name Field
    Dim subject1 As String  ' What the email is about
    Dim ccemail As String   ' Inspectors email
    [COLOR="Red"]Dim email3 As String    ' Prompted Email[/COLOR]
    
    Sheets("Teams").Select    ' targets Office worksheet
    ccemail = WorksheetFunction.VLookup(cbauditor2, Range("B31:D34"), 3, 0)    'returns email address
    date2 = Worksheets("Office").Range("B3").Value    ' Date
    Worksheets("Office").Range("B2").Value = cbozone    'zone
    Sheets("Teams").Select    ' targets Office worksheet
    email2 = WorksheetFunction.VLookup(cbozone, Range("A5:D28"), 4, 0)    'returns email address
    
    [COLOR="Red"]email3[/COLOR] = Application.InputBox("Please enter Email To Automatically Email this To:")
    Worksheets("Office").Range("E4").Value = [COLOR="Red"]email3[/COLOR]
        
    With OutMail
        .To = [COLOR="Red"]Array(email2, email3)[/COLOR] ' who email is going to
        .CC = Array(ccemail, "joe.king@email.com")    ' facilatator
        .Subject = subject1    ' What the Email is about
        .Attachments.Add ActiveWorkbook.FullName
        .Body = ActiveSheet.Value
        .Send
    End With
    
End Sub

 

[weaselmcguff]

Thanks Got it to work

Much appreciated on the response