Sending multiple emails through excel

[AlaaEddin]

I have this VBA script:

Private Sub sendEmail_Click()
'Updated by Extendoffice 2017/9/14
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String

On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Body content" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = "someone@someone.com"
.CC = ""
.BCC = ""
.Subject = "Test email send by button clicking"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub


I want the sending of mails to be for multiple emails which are exists in E column how I can perform that I am so confused...

 

[AlaaEddin]

I found the solution and I would like to share it with you:

Private Sub CommandButton1_Click()
Dim cell As Range
Dim strto As String
For Each cell In ThisWorkbook.Sheets("Sheet1").Range("E2:E100")
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If
Next cell
If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)


Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon


On Error GoTo cleanup
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = strto
.subject = "Enter subject here"
.body = "" ' EMPTY FOR NOW
'USE THIS FOR ENTERING NAMES OF RECIPIENTS IN BODY TEXT "here"
'"Dear" & Cells(cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
"Enter body text " & _
"here"
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
'.Send 'Or use Display
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

don't worry about _click I just linked the code with a button now this is the code and just change the range in the 4th line

Thanks all.