Error al adjuntar archivo para enviar por email con vba
A ver si me pueden ayudar. Tengo creado un código en vba para enviar mails automáticamente sin necesidad de abrir el Outlook, hasta ahí todo bien. Lo que no soy capaz es lograr que me adjunte un archivo. Me salta un error en "Email.Attachments.Add (Me.txt_Adjunto)" y el mensaje de (Visual Basic) previo al error es el siguiente: Se ha producido el error '13' en tiempo de ejecución. No coinciden los tipos. Realmente si pincho ahí en el sombreado amarillo si que aparece la ruta.
Tengo otro código que si lo hace pero me abre el Outlook y lo que pretendo es enviar sin necesidad de estar abriendo el Outlook.
Gracias y buena tarde.
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
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
Email.Configuration.Fields(cdoSMTPServer) = "mail.pepito.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(25) 'hotmail
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
Autentificacion = True
If Autentificacion Then
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "[email protected]" 'CONFIGURAR CUENTA QUE ENVIA MAIL
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "1234" 'CONFIGURAR PASSWORD DE CUENTA QUE ENVIA MAIL
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
End If
Email.To = Me.txt_Para
Email.From = "[email protected]" 'CONFIGUAR CUENTA QUE ENVIA MAIL
Email.CC = Me.txt_CCOO
Email.Subject = Me.txt_Asunto
Email.TextBody = Me.txt_Mensaje
Email.Attachments.Add (Me.txt_Adjunto)
Email.Configuration.Fields.Update
'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
1 Respuesta
¿Probaste así?:
Email. Attachments. Add Me.txt_Adjunto
Lógicamente en el formulario desde el que corres el código debe existir un cuadro de texto llamado txt_Adjunto y debe contener la ruta completa, con nombre y extensión, del archivo.
Yo nunca encontré problemas en esa línea para enviar archivos vía VBA.
Muchas gracias por contestar, si tengo el txt_Adjunto en el frm y copia la ruta completa incluida la extensión. Y me sigue dando error. Me imagino que ya lo sabes el mail lo envía sin abrir el Outlook. En cambio el mismo frm si lo envío a través de Outlook si que lo envía. Gracias por la paciencia.
este ejemplo de Neckkito: http://neckkito.xyz/nck/index.php/ejemplos/18-codigo/164-y-tres-de-mail
Fíjate que usa "File://" y luego la ruta al archivo.
Muchas gracias por contestar, he modificado un poco el código y si me funciona si lo configuro por ejemplo con Hotmail, con gmail debe haber un problema de conexión con el servidor que no me va. Si puedes saber cual es agradecería que me lo indicaras. A continuación paso el código como lo tengo por si le sirve a alguien. Siempre agradecido por su colaboración
Private Sub cmdEnviarMailAdjunto_Click() Dim Email As CDO.Message Set Email = New CDO.Message 'con gmail da error, aun está sin arreglar 'correo = "[email protected]" 'El gmail da error 'passwd = "1234" correo = "[email protected]" passwd = "1234" 'aquí tiene que indicar la contraseña del mail destino = Me.txt_Para 'Destinatario mensaje = Me.txt_Asunto 'Asunto Texto = Me.txt_Mensaje 'Texto a redactar ccoo = Me.txt_CCOO archivo = Me.txt_Adjunto Email.Configuration.Fields(cdoSMTPServer) = "smtp.live.com" Email.Configuration.Fields(cdoSendUsingMethod) = 2 With Email.Configuration.Fields .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(25) 'CLng(465) .Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1) .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = correo .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = passwd .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True End With With Email .To = destino .From = correo .CC = cc00 .Subject = mensaje .TextBody = Texto .AddAttachment archivo .Configuration.Fields.Update On Error Resume Next .Send End With If Err.Number = 0 Then MsgBox "El mail se envió con éxito", vbInformation, "Mensaje" Else MsgBox "Se produjo el siguiente error: " & Err.Description, vbCritical, "Error nro " & Err.Number End If End Sub
En el artículo, Neckkito comenta algo de que en gmail hay que configurar una serie de permisos. A ver si es lo que te falta.
