VBA Outlook single mail instead of multiple mails to recipient

[Maxicus]

Hi

I have the following code, which works but would like to improve.

the purpose of the code is to send a report to multiple recipients at once, these recipients mail addresses are found on Sheet1 Column H. they are also dynamic.

the code works fine in the sense that it opens and creates the attachment for each recipient, but it creates a new mail for each recipient. I would only like to change it so that it creates a single new mail and then places all the recipients into one e-mail.

Dim OutApp As Object    
Dim OutMail As Object    
Dim cell As Range
    
Application.ScreenUpdating = False    
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup    
For Each cell In Sheet1.Columns("H").Cells.SpecialCells(xlCellTypeConstants)        

If cell.Value Like "?*@?*.?*" Then

Set OutMail = OutApp.CreateItem(0)            

On Error Resume Next            

With OutMail                
.To = cell.Value                
.Subject = "Reminder"               
.Body = "Dear "                
.Attachments.Add Sheet1.Range("B4") & "\3. SHE Reports\" & Sheet1.Range("AP4") & " " & Sheet1.Range("AO4") & " SHE REPORT" & ".pdf"      
.Display            
End With            
On Error GoTo 0            
Set OutMail = Nothing        

End If    
Next cell
cleanup:    
Set OutApp = Nothing    
Application.ScreenUpdating = True

[mancubus]

assumptions:
1 recipients' email addresses are in a contiguous range in column H, starting at H1 (ie, there is no header cell)
2) Outlook separator is semicolon ";"

Sub vbax_63139_multi_recipient_email()

    With CreateObject("Outlook.Application")
        With .CreateItem(olMailItem)
            .To = Join(Application.Transpose(Range("H1").CurrentRegion), ";")
            .Subject = "Reminder"
            .Body = "Dear "
            .Attachments.Add Sheet1.Range("B4") & "\3. SHE Reports\" & Sheet1.Range("AP4") & " " & Sheet1.Range("AO4") & " SHE REPORT" & ".pdf"
            .Display
        End With
    End With

End Sub