Envio de WhatsApp con varios registros

   Hola a todos(as).Soy nuevo en este foro.
He creado un procedimiento para enviar WhastApp desde Access y lo hace bien y es este:
Private Sub btnEnviarW_Click()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim whatsappWebURL As String
    Dim varPrefijo As String
    Dim varMensaje As String
    Dim respuesta As VbMsgBoxResult
    Dim strSQL As String

    ' Asignar el prefijo del país
    varPrefijo = "+34"

    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT tb_pendientes.*, tb_cliente.telefono,tb_cliente.nombre " & _
                              "FROM tb_pendientes INNER JOIN tb_cliente ON tb_pendientes.nºcliente = tb_cliente.nºcliente " & _
                              "WHERE tb_pendientes.fechaVto <= Date()")

    respuesta = MsgBox("¿Quiere enviar el WhatsApp para los registros encontrados?", vbQuestion + vbYesNo, "Enviar WhatsApp")

    If respuesta = vbYes Then
        If Not rs.EOF Then
            Do Until rs.EOF
                If Not IsNull(rs("telefono")) Then
                    varMensaje = "EMPRESA - Aviso de vencimiento." & vbCrLf & _
                                   " Estimado(a) " & rs("nombre") & ";" & vbCrLf & _
                                   "Le recordamos que la albaran numero: " & rs("nºdocumento") & " con fecha: " & rs("fecha") & " y de importe: " _
                                   & rs("importe") & " ha vencido el dia: " & rs("fechaVto") & "." & vbCrLf & _
                                   "P.D: OJO, aviso solo por su facturas vencimiento." & vbCrLf & _
                                   "Saludos."
                    ' Construir el URL
                    whatsappWebURL = "https://web.whatsapp.com/send?phone=" & varPrefijo & rs("telefono") & "&text=" & varMensaje
                    ' Abrir WhatsApp
                    FollowHyperlink whatsappWebURL
                    ' Retardo
                    Sleep (12000)
                    SendKeys "{ENTER}", True
                    ' Activar la tecla "Bloq Num"
                    SendKeys "{NUMLOCK}", True
                End If
                ' Incrementar el campo "aviso" en la tabla tb_pendientes
                strSQL = "UPDATE tb_pendientes SET aviso = IIf(IsNull(aviso), 1, aviso + 1) WHERE Id_Pendiente = " & rs("Id_Pendiente")
                db.Execute strSQL
                rs.MoveNext
            Loop
            ' Cerrar WhatsApp
            SendKeys "%{F4}", True ' Alt + F4
        Else
            MsgBox "No se encontraron registros para enviar.", vbInformation, "Enviar WhatsApp"
        End If
    End If

    ' Cerrar el recordset
    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

CONSULTA:
La consulta es la siguiente, si tengo varios registros que cumplen la misma condición quería enviarlos juntos.

¿Seria posible implementarlo así, o se os ocurre otra alternativa?

No se si la ruta para descargar el archivo está bien. No veo otra forma de subir el archivo.
Archivo:http://drive.google.com/file/d/1z4RA-FrR_NAMlxCcO3tHfOGBwQKSkRiI/view?usp=drive_link

Saludos