ใช้สูตรใน Excel เลยครับ  อย่าให้เดือดร้อน Access เลย   

                            Dim expXLS, Sheet1, Sheet2, Sheet3, Sheet4, ไปเรื่อยๆ As String
                            expXLS = "D:\test.xls"
                            Sheet1 = "ตาราง/คิวรี่1"
                            Sheet2 = "ตาราง/คิวรี่2"
                            Sheet3 = "ตาราง/คิวรี่3"
                            Sheet4 = "ตาราง/คิวรี่4"
                            ไปเรื่อยๆ.............
                            DoCmd.TransferSpreadsheet acExport, เวอร์ชั่น Excel, Sheet1, expXLS, True
                            DoCmd.TransferSpreadsheet acExport, เวอร์ชั่น Excel, Sheet2, expXLS, True
                            DoCmd.TransferSpreadsheet acExport, เวอร์ชั่น Excel, Sheet3, expXLS, True
                            DoCmd.TransferSpreadsheet acExport, เวอร์ชั่น Excel, Sheet4, expXLS, True
                            DoCmd.TransferSpreadsheet acExport, เวอร์ชั่น Excel, ไปเรื่อยๆ, expXLS, True

#If Win64 Or VBA7 Then    ก็  Win64

#If Win64 Or VBA7 Then
    Private Declare PtrSafe Function GetKeyState Lib "user32.dll" (ByVal nVirtKey As Long) As Integer
#Else
    Private Declare Function GetKeyState Lib "user32.dll" (ByVal nVirtKey As Long) As Integer
#End If

ใส่  PtrSafe   กับไม่ใส่

เหมือนจะง่าย  แต่กว่าจะเข้าใจ  นำมาฝากครับ  วินโดว์ 7 ขึ้นมา ใช้ SendKeys "{HOME}" และ  SendKeys "{END}" ไม่ได้แล้ว

Option Compare Database

#If Win64 Or VBA7 Then
    Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Private Declare PtrSafe Function GetKeyState Lib "user32.dll" (ByVal nVirtKey As Long) As Integer
#Else
    Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Private Declare Function GetKeyState Lib "user32.dll" (ByVal nVirtKey As Long) As Integer
#End If

    Private Const VK_HOME = &H24
    Private Const VK_END = &H23
    Private Const VK_F2 = &H71
   
Private Sub Command2_Click() 'SendKeys HOME
    Me.Text0.SetFocus
    keybd_event VK_F2, 1, 0, 0
    keybd_event VK_F2, 1, KEYEVENTF_KEYUP, 0
    keybd_event VK_HOME, 1, 0, 0
    keybd_event VK_HOME, 1, KEYEVENTF_KEYUP, 0
End Sub

Private Sub Command3_Click() 'SendKeys END ใช้ F2 แทน
    Me.Text0.SetFocus
    keybd_event VK_F2, 1, 0, 0
    keybd_event VK_F2, 1, KEYEVENTF_KEYUP, 0
End Sub

ตามนี้ครับ

ไปได้โค๊ดที่อาจารย์ลงไว้ใน Youtube
ผมเก็บเมลล์เพื่อนๆ ไว้ถ้าต้องการ Loop ชื่อเมลล์ลงในบรรทัด  .To = Nz(ฟิลด์เก็บเมลล์)
ต้องทำโค๊ดยังไงครับ  หรือมีโค๊ดอื่นมั๊ยครับ สำหรับการส่งเมลล์เป็นกลุ่มๆ

On Error GoTo Err:
    Dim NewMail As Object
    Dim mailConfig As Object
    Dim fields As Variant
    Dim msConfigURL As String

    'late binding
    Set NewMail = CreateObject("CDO.Message")
    Set mailConfig = CreateObject("CDO.Configuration")

    ' load all default configurations
    mailConfig.Load -1

    Set fields = mailConfig.fields

    'Set All Email Properties
    With NewMail
        .Sender = Forms!mainmail!mygmail
        .From = Nz(Forms!mainmail!mydetail)
        .To = Nz(Me.fmail)  '<<<<<<<<< ต้องการ Loop  ลงตรงนี้  <<<<<<<<<<<<<<<<<<<<
        .CC = Nz(Forms!mainmail!sumnao1)
        .BCC = Nz(Forms!mainmail!sumnao2)
        .Subject = Nz(Forms!mainmail!ruang1)
        .BodyPart.Charset = "utf-8"
        .HTMLbody = "<Font Face=AngsanaUPC Size=" & Forms!mainmail!fontSiz & " Color=" & Forms!mainmail!seefon & ">" & Forms!mainmail!bui1 & Nz(Forms!mainmail!detail2) & Forms!mainmail!bui2 & "</Font>"
       
        If Not IsNull(Forms!mainmail!fi1) Then
            If Dir(Forms!mainmail!fi1) <> "" Then
                .Addattachment Nz(Forms!mainmail!fi1)
            End If
        End If
       
        If Not IsNull(Forms!mainmail!fi2) Then
            If Dir(Forms!mainmail!fi2) <> "" Then
                .Addattachment Nz(Forms!mainmail!fi2)
            End If
        End If
       
        If Not IsNull(Forms!mainmail!fi3) Then
            If Dir(Forms!mainmail!fi3) <> "" Then
                .Addattachment Nz(Forms!mainmail!fi3)
            End If
        End If
       
    End With

    msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

    With fields
        .Item(msConfigURL & "/smtpusessl") = True
        .Item(msConfigURL & "/smtpauthenticate") = 1
        .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
        .Item(msConfigURL & "/smtpserverport") = 465
        .Item(msConfigURL & "/sendusing") = 2
        .Item(msConfigURL & "/sendusername") = Forms!mainmail!mygmail
        .Item(msConfigURL & "/sendpassword") = DLookup("mypass", "mypass")
        .Update
    End With
    NewMail.Configuration = mailConfig
    NewMail.Send

Exit_Err:
    'Release object memory
    Set NewMail = Nothing
    Set mailConfig = Nothing
    End

Err:
    Select Case Err.Number
    Case -2147220973  'Could be because of Internet Connection
        MsgBox "Check your internet connection." & vbNewLine & Err.Number & ": " & Err.Description
    Case -2147220975  'Incorrect credentials User ID or password
        MsgBox "Check your login credentials and try again." & vbNewLine & Err.Number & ": " & Err.Description
    Case Else   'Report other errors
        MsgBox "Error encountered while sending email." & vbNewLine & Err.Number & ": " & Err.Description
    End Select

    Resume Exit_Err

จากข้อมูลที่ให้มา ถ้าเอาไปเรียง ลำดับจากน้อยไปหามาก  มันจะเรียงได้ยังไงครับ  ข้อมูลเดียวกัน เหมือนกันทุกแถว  มันต้องสร้างฟิลด์เพื่อระบุการทำงานก่อนหลังด้วยครับ เป็นไปได้ช่องวันที่ ควรเก็บวันที่ ที่มีเวลาเข้าไปด้วย  Now()  หรืออาจจะสร้างฟิลด์ ID  ขึ้นมา

#If Win64 Or VBA7 Then
   Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
#Else
   Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
#End if

ทำโค๊ดแบบนี้  เอาไว้ไปรันกับเวอร์ชั่นเก่า และใหม่ได้เลย