VBA - Embed multiple files in Outlook body

Sub SendEmail_Contacts()
 
    Dim olApp As Object, olMsg As Object
    Dim rs As DAO.Recordset
    
    Set olApp = CreateObject("Outlook.Application")
    Set rs = CurrentDb.OpenRecordset("NameOfTable")
    
 
    Do While Not rs.EOF
        If Nz(rs!EmailAddr, "") <> "" Then
            Set olMsg = olApp.CreateItem(0)
            With olMsg
                .To = rs!EmailAddr
                .Subject = rs!Subject
                .Body = rs!Body
                '-------------Embed multiple images (eg HTML) in body -----------
                
                
                
                '-------------add multiple attachments --------------------------
                        Dim j As Integer
                        For j = 0 To FileList.ListCount - 1
                            oMsg.Attachments.Add FileList.Column(0, j)
                        Next j
                '----------------------------------------------------------------
                
                .Send
            End With
        End If
        rs.MoveNext
    Loop
 
    Set olMsg = Nothing
    Set olApp = Nothing
    rs.Close
    Set rs = Nothing
 
    MsgBox "Done"
 
End Sub

Select allOpen in new window