VBA: Send E-mail using Outlook with E-mail addresses from a cell range

[K1600]

I am trying to get my VBA code to send an e-mail, where the subject and body of the e-mail are entered into text fields in a UserForm and the e-mail addresses are all listed in cells A1:A10 in a 2nd workbook on a sheet titled 'Admin Users'. I have the below code which works fine if I want a input an e-mail address into a text box but I can't work out how to get it to get my addresses from the cell range.

Any help would be most helpful.

Thanks.

Dim oOutlook As Object

    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")
    On Error GoTo 0

    If oOutlook Is Nothing Then
        MsgBox "Please open Microsoft Outlook (e-mail application) and then press 'Submit' again", vbCritical
    Exit Sub
    Else
    End If

'Sends e-mail
Dim OutApp  As Object
Dim OutMail As Object
Dim wbk     As Workbook

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'Set wbk = <<<<<< This needs the path for the master workbook

    On Error Resume Next
    With OutMail
'        .To = '<<<<<<< Needs to get e-mail addresses from A2:A10 on sheet 'Admin Users'

        .Subject = Me.TxtEmailSubject
        .body = Me.TxtEmailBody
        
        .Send
    End With
        On Error GoTo 0
        
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set wbk = Nothing

 

[DanteAmor]

Try this

In the macro change "book2.xlsx" for the name of your book
Note: The second book must be open.

Private Sub CommandButton1_Click()
  Dim oOutlook As Object
  
  On Error Resume Next
  Set oOutlook = GetObject(, "Outlook.Application")
  On Error GoTo 0
  
  If oOutlook Is Nothing Then
    MsgBox "Please open Microsoft Outlook (e-mail application) and then press 'Submit' again", vbCritical
    Exit Sub
    Else
  End If
  
  'Sends e-mail
  Dim OutApp  As Object
  Dim OutMail As Object
  Dim wbk     As Workbook
  Dim i As Long, users As String
  
  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(0)
  'Set wbk = <<<<<< This needs the path for the master workbook
  
  For i = 2 To 10
    users = users & Workbooks("book2.xlsx").Sheets("Admin Users").Range("A" & i).Value & ";"
  Next
  
  On Error Resume Next
  With OutMail
    .To = users
    .Subject = Me.TxtEmailSubject
    .body = Me.TxtEmailBody
    .display '.Send
  End With
  On Error GoTo 0
  
  Set OutMail = Nothing
  Set OutApp = Nothing
  Set wbk = Nothing
End Sub

 

[K1600]

Perfect! With a slight tweak to make it open the 2nd workbook and it's working a dream.

Thank you kindly.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.