Boa noite!!

Considerando VBA de Excel (e não Outlook), já que estamos em um fórum especifico para excel, então..

Eu achei isso...tente adpatar.

Autores Desconhecidos.

Sub ReadExcel()


    Dim OutApp As Object
    Dim fLoc As String
    Dim cell As Range, rng As Range
    Dim vFile As Variant, vFiles As Variant


    'Range of cells with recipeant info
    'Column A is attaachment filenames (multiple filenames separated by ; e.g File1.xls;File2.xls
    'Column B is the email address
    'Column C is the File path for the attachment files
    With ThisWorkbook.ActiveSheet
        Set rng = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    End With
    
    Set OutApp = CreateObject("Outlook.Application")
    
    ' Read in the data and create a new message with attachment for each Excel entry
    For Each cell In rng
    
        'File path in column C
        fLoc = cell.Offset(, 2).Value
        If Right(fLoc, 1) <> "" Then fLoc = fLoc & ""
        
        'Create a new Email for each recpient
        With OutApp.CreateItem(0)
            'Recipient
            .Recipients.Add cell.Offset(, 1).Value
            
            'Attach each file
            vFiles = Split(cell.Value, ";")
            For Each vFile In vFiles
                If Len(Dir(fLoc & vFile)) Then
                    .Attachments.Add fLoc & vFile
                Else
                    AppActivate ThisWorkbook.Parent
                    MsgBox "Could not locate file: " & vbCr & fLoc & vFile, , "File Not Found"
                End If
            Next vFile
            
            .Display
            ' .Subject = "Put your subject here"
            ' .Send
        End With
    Next cell
    
End Sub

Sub CreateEmail()

'write the default Outlook contact name list to the active worksheet

Dim OlApp As Object
Dim OlMail As Object
Dim ToRecipient As Variant
Dim CcRecipient As Variant

Set OlApp = CreateObject("Outlook.Application")
Set OlMail = OlApp.CreateItem(olmailitem)

For Each ToRecipient In Array("User 1", "User 2", "User 3")
OlMail.Recipients.Add ToRecipient
Next ToRecipient

For Each CcRecipient In Array("User 4", "User 5", "User 6")
With OlMail.Recipients.Add(CcRecipient)
.Type = olCC
End With
Next CcRecipient

'fill in Subject field
OlMail.Subject = "Test of Outlook email"

'Add the active workbook as an attachment
OlMail.Attachments.Add ActiveWorkbook.FullName

'Display the message
OlMail.Display 'change this to OlMail.Send if you just want to send it without previewing it

End Sub