Access - Mandar datos a Word y mandar documentopor mail

Private Sub btnEnviarCorreo_Click()

    'Establecer una referencia al objeto de la aplicación de Word

    Dim objWord As Object

    Set objWord = CreateObject("Word.Application")

    'Establecer una referencia al documento de Word basado en la plantilla

    Dim objDoc As Object

    Set objDoc = objWord.Documents.Add("ruta_de_la_plantilla")

    'Realizar la consulta en Access y obtener los datos

    Dim strSQL As String

    strSQL = "SELECT campo1, campo2, campo3 FROM tabla"

    Dim rs As Recordset

    Set rs = CurrentDb.OpenRecordset(strSQL)

    'Insertar los datos en la plantilla de Word utilizando los marcadores de posición

    objDoc.Bookmarks("Marcador1").Range.Text = rs("campo1")

    objDoc.Bookmarks("Marcador2").Range.Text = rs("campo2")

    objDoc.Bookmarks("Marcador3").Range.Text = rs("campo3")

    'Cerrar la conexión de la base de datos

    rs.Close

    'Guardar el documento de Word con un nombre único

    Dim strNombreArchivo As String

    strNombreArchivo = "NombreUnicoDelArchivo.docx"

    objDoc.SaveAs strNombreArchivo

    'Cerrar el documento y la aplicación de Word

    objDoc.Close

    objWord.Quit

    'Crear un objeto Outlook para enviar el correo electrónico

    Dim objOutlook As Object

    Set objOutlook = CreateObject("Outlook.Application")

    Dim objMensaje As Object

    Set objMensaje = objOutlook.CreateItem(0)

    'Agregar el archivo adjunto al correo electrónico y enviarlo

    objMensaje.Attachments.Add strNombreArchivo

    objMensaje.To = "destinatario@correo.com"

    objMensaje.Subject = "Asunto del correo electrónico"

    objMensaje.Body = "Mensaje del correo electrónico"

    objMensaje.Send

    'Eliminar el archivo temporal de Word

    Kill strNombreArchivo

    'Liberar los objetos utilizados

    Set objOutlook = Nothing

    Set objMensaje = Nothing

    Set objWord = Nothing

    Set objDoc = Nothing

End Sub