Hi All

I have specified the email addresses in the code to whom the email will be sent when the user presses "Send Email" button but now I want to add all the addresses in the Access table and write down the code that will send an email to those people whose addresses are in the Access table. Can anybody please change the code accordingly?

private sub SendEmail_Click()
Mail_Selection_Range_Outlook_Body("Report")
end sub

Sub Mail_Selection_Range_Outlook_Body(a As String)

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next
   
    Set rng = ThisWorkbook.Worksheets("sheet12").UsedRange
    
    On Error GoTo 0

    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = New Outlook.Application
    Set OutMail = OutApp.CreateItem(olMailItem)

    On Error Resume Next
    With OutMail
      .Recipients.Add "aaaaaa"
      .Recipients.Add "bbbbbb"

     
         .Recipients.Add "cccccc"
                                     
        .Subject = a
        .HTMLBody = RangetoHTML(rng)
        .Send
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    
    TempWB.Close SaveChanges:=False
 
    
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function