send email to multiple recipients

I am sending e-mail from excel; I am having problem with this portion of the code:
'---------------------------------------------------
With .Recipients.Add(RecipientEmail)
.Type = olTo
If Not .Resolve Then
MsgBox "Unable to resolve address."
Exit Sub
End If
End With
'--------------------------------------------------------
The “RecipientEmail” is a value from an Excel Cell; everything works fine as long as I have only one e-mail address in that Excel Cell; If I have multiple addresses, separated by “;” (ex: email1@xxx.com; email2@xxx.com; and so on….), than, I am getting the "Unable to resolve address."
How can I send one e-mail to multiple recipients?
Thanks

Here is some example code to loop through cells in A1 thru A3.

Option Explicit

Sub Send_To_Multiple()
    
    Dim OutApp As Object
    Dim OutMail As Object
    Dim emailRng As Range, cl As Range
    Dim sTo As String

    Set emailRng = Worksheets("Sheet1").Range("A1:A3")

    For Each cl In emailRng
        sTo = sTo & ";" & cl.Value
    Next

    sTo = Mid(sTo, 2)

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = sTo
        .CC = ""
        .BCC = ""
        .Subject = "Hello"
        .Body = "Email Body"

        .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Thanks for the response, however, I have it a little bit different:
Instead of having a Worksheets("Sheet1").Range("A1:A3"), I have VBA moving down the along A1:A3 and
If RecipientEmail = "" Then Exit Do
So, I can not use the "emailRng" and due to my lack of knowledge, I am unable to adopt this solution .
Could you please give me another "push"?
Thanks

Hi, I'm not sure how much code you have for what you are doing. Can you post all the current code? Can you have an email list in a column?

Here is what I "hammered" together (spread sheet attached); Does not look very good but works until I am listing more than one recipient in one cell:
'---------------------------------------------------------------------------------------------------------------------------------------------------
Public olApp As New Outlook.Application
Public nsMAPI As Outlook.Namespace
Public exp As Outlook.Explorer

'=========================Function CountFiles================================================================
Function CountFiles(tgtDir As String) As Integer
Dim fName As String
'Retrieve the first entry, handle error if directory not found
On Error GoTo badDirectory
fName = Dir(tgtDir & "\*.*")

On Error GoTo 0

'loop through all files in the directory and increment the function's value
Do While fName <> ""

' Ignore the current directory and
' the encompassing directory.

If fName <> "." And fName <> ".." Then
CountFiles = CountFiles + 1
End If

' Get next entry.
fName = Dir()
Loop
Exit Function

badDirectory:
'come here if directory cannot be accessed
MsgBox "The directory you specified does not exist or " & _
"cannot be accessed. Activity halted."
End



End Function

'=========================END FUNCTION COUNTFILES============================================================

Sub EmailRFQ()
Dim itmMail As Outlook.MailItem
Dim x As Variant
Dim y As Variant
Dim k As Integer
Dim RecipientName As String
Dim Manuf As String
Dim RecipientEmail As String
Dim myAttachments As Outlook.Attachments
Dim filecount As Integer
Dim strFolder As String
Dim strFileN As String
Dim mymessage As String
k = 0
filecount = 0
Filelocation = Application.ActiveWorkbook.Path
strFolder = Filelocation & "\Attachments\"
filecount = CountFiles(Filelocation & "\Attachments\")


'Return a reference to the MAPI layer
Set nsMAPI = olApp.GetNamespace("MAPI")

'Set the current cell selection equal to the e-mail address
'x = ActiveCell.Value
x = ActiveSheet.Range(Cells(1, 2), Cells(1, 2))
If x = "" Then
CreateObject("WScript.Shell").Popup "Message Is Empty ", 2
Exit Sub
End If
Do
'x = Range("b2").Value


RecipientName = Range(Cells(2 + k, 1), Cells(2 + k, 1))


RecipientEmail = Range(Cells(2 + k, 2), Cells(2 + k, 2))


Manuf = Range(Cells(2 + k, 3), Cells(2 + k, 3))
If x = "" Then Exit Do

If RecipientEmail = "" Then Exit Do


'Set the cell RecipientsSheet!b1 equal to the message body
Application.ScreenUpdating = False
Worksheets("RecipientsSheet").Activate
y = Range("b1").Value

'Create a New mail message item
Set itmMail = olApp.CreateItem(olMailItem)
Set myAttachments = itmMail.Attachments
With itmMail

'Add the subject of the mail message
.Subject = Range("a1").Value
'Create some body text
.Body = RecipientName & "," & vbNewLine & vbNewLine & _
y & vbCrLf & vbNewLine & vbNewLine & _
"Please respond to confirm ..." & vbNewLine & vbNewLine & _
"Thank you," & vbNewLine & vbNewLine & _
"My Name" & vbNewLine & _
"My Title"

'Add a recipient and test to make sure that the
'address is valid using the Resolve method

With .Recipients.Add(RecipientEmail)

.Type = olTo
If Not .Resolve Then
MsgBox "Unable to resolve address."
Exit Sub
End If
End With

'============add Attachment==================================================


strFileN = Dir(strFolder & FileType)

Do While Len(strFileN) > 0
myAttachments.Add strFolder & strFileN
strFileN = Dir
Loop

'itmMail.Display
'======================END add Attachment



.Send
End With


'Release memory
Set itmMail = Nothing
Set nsMAPI = Nothing
Set olApp = Nothing
k = k + 1
Loop
ExitProc:
Set olApp = Nothing
CreateObject("WScript.Shell").Popup "RFQ-s Sent to " & k & " Recipients", 3



1000 End Sub

Can you post the workbook that contains the code? Strip out the emails of course and just place a couple examples in the actual locations.

I have attached the file called "Recipients.xlsx" (see my previous reply). Isn't that what you asking for ?
Thank you

If that is where you are running the code from, then yes. I was asking because when I pasted the code into a module, I was getting errors.

Probably, when I "cleaned up" the script before posting, I deleted things that causing the error.
I think the problem is in the statement:
With .Recipients.Add(RecipientEmail)
which can not take the multiple e-mail addresses from Cell B2; if I could overcame that , everything else would run, because it runs when it has only one address.
Thanks.

I think where you are getting the error with .Resolve is... this is checking the names and it cannot determine that there are multiple names in one cell, so I believe it is treating it as one and giving you the error. Hopefully someone might chime in here that has dealt more with using .Resolve. Otherwise, you might have to ignore it, or rewrite some of the code and use the example I posted so the code will separate the names at each semi-colon.

When your code separates the names, the e-mails will go out as separate e-mails with one single name under "To" or they will be "regrouped" as multiple E-mails in the "To" window of the Message?
I mean if in Cell B2 I have 3 recipients, than I will have 3 e-mails going out?
Thanks

No, all the names that are in one cell will populate the TO box. If you open a new workbook, paste the code I posted in a standard module. Put multiple names in a cell in Column A separated by a semicolon. Then place singles in each cell after or before that in Column A. This will give you a look at how it works.