Enviar archivo adjunto desde una macro Excel por mail desde un formulario vba

Quería enviar un archivo adjunto por mail .Tengo código que envía mail perfectamente pero no se como programar para que me envié el adjunto. Paso el código que tengo ahora mismo. Los correos no los muestro, le he puesto una x.

Saludos y buen día a todos.

Private Sub btn_EnviarMail_Click()
'Dimensiono variables
Dim Email As CDO.Message
Dim Autentificion As Boolean
Dim dests As String
'Creo el objeto email
Set Email = New CDO.Message
'CONFIGURAR DATOS DEL SERVIDOR QUE ENVIA MAIL
'Ponemos datos del servidor a usar
Email.Configuration.Fields(cdoSMTPServer) = "mail.xxxxxxxx.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
'Indicamos el número de puerto smtp
'Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465) 'gmail
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(25) 'hotmail
'Decimos si requiere o no autentificación 1 requiere, 0 no requiere
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)
'Segundos de espera
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
'Definición de verdadero para la autentificación
Autentificacion = True
'Configuramos el ingreso al mail
If Autentificacion Then
    'nombre de usuario
    Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "[email protected]" 'CONFIGURAR CUENTA QUE ENVIA MAIL
    'password
    Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxx" 'CONFIGURAR PASSWORD DE CUENTA QUE ENVIA MAIL
    'si el servidor utiliza SSL (secure socket layer). en gmail: True
    Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
End If
' Una vez configurado nuestro servidor de correo tomados datos de excel para enviar el mail
    With Email
    'Correo del destinatario
    dests = dest1 'CONFIGURAR CUENTA DONDE ENVIAR MAIL ej para varios mails "[email protected],[email protected]"
    '"[email protected]," &
    '''Email.To = dests
    .To = Me.txt_Para
    'Dirección del remitente
    .From = "[email protected]" 'CONFIGUAR CUENTA QUE ENVIA MAIL
   ' Dejar copia
    '''Email.CC = "[email protected]"
    .CC = Me.txt_CCOO
   ' Asunto
    .Subject = Me.txt_Asunto
   ' Mensaje
    .TextBody = Me.txt_Mensaje
   'Archivo adjunto
    . Attachments.Add 'ME PIERDO AQUÍ, GUARDO EL NOMBRE DE ARCHIVO EN EL txt_adjunto que previamente e incorporado
   'Actualizamos datos antes del envio
    .Configuration.Fields.Update
   End With
   'Controlo errores
   On Error Resume Next
   'enviamos propiamente el mail
    Email.Send
    'Si no hay errores la funcion es verdadero
    If Err.Number = 0 Then
       SendMail_Gmail = True
    Else
     'Sale msgbox con descripción del error
       MsgBox "Se produjo el siguiente error: " & Err.Description, vbCritical, "Error nro " & Err.Number
   End If
   'Borro los objetos
    If Not Email Is Nothing Then
       Set Email = Nothing
    End If
    'Controlo errores
    On Error GoTo 0
End Sub
---------------------------------------------------------
'macro para guardar nombre de archivo en txt_adjunto:
Private Sub btn_AñadirAdjunto_Click()
Dim objFileDialog As Office.FileDialog
Dim ruta As String
Set objFileDialog = Application.FileDialog(msoFileDialogFilePicker)
With objFileDialog
    .AllowMultiSelect = False
    .ButtonName = "Aceptar"
    .Title = "Elija un archivo"
    If .Show = True Then
        NombreArchivo = Mid$(.SelectedItems(1), InStrRev(.SelectedItems(1), "\") + 1)
        MsgBox NombreArchivo
       Me.txt_Adjunto = NombreArchivo
       'ruta = Trim(.SelectedItems.Item(1))
       'Me.txt_Adjunto = ruta
    End If
End With
End Sub

Añade tu respuesta

Haz clic para o