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