Visual Basic - ENVIAR CORREO ADJUNTO DESDE VISUAL BASIC 6.0

Life is soft - evento anual de software empresarial
 
Vista:
sin imagen de perfil

ENVIAR CORREO ADJUNTO DESDE VISUAL BASIC 6.0

Publicado por FABIAN (1 intervención) el 07/12/2013 22:14:04
Hola
bueno soy nuevo en este lugar y espero que alguien me pueda ayudar en una consulta , pues bueno voy al punto:

Estoy creando una apicacion en visula basic 6.0 para enviar correos con varios archivos adjuntos, para esto uso un command para adjuntarlos y se muestren en un text, sucede que si borro las lineas que corresponden al archivo adjunto me envia los datos correctamente pero al añadir las lineas para el o los archivos adjuntos me arroja un error:

Este es el código que utilizo:

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' El ejemplo para poder enviar el mail necesita la referencia a: _
> Miscrosoft CDO Windows For 2000 Library ( es el archivo dll cdosys.dll )

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Function Enviar_Mail_CDO(SerVidor_SMTP As String, _
PARA As String, _
DE As String, _
ASUNTO As String, _
MENSAJE As String, _
Optional Path_Adjunto As String, _
Optional PUERTO As String = "25", _
Optional USUARIO As String, _
Optional PASSWORD As String, _
Optional Usar_Autentificacion As Boolean = True, _
Optional Usar_SSL As Boolean = True) As Boolean


Me.MousePointer = vbHourglass

' Variable de objeto Cdo.Message
Dim Obj_Email As CDO.Message


' Crea un Nuevo objeto CDO.Message
Set Obj_Email = New CDO.Message

' Indica el servidor Smtp para poder enviar el Mail ( puede ser el nombre _
del servidor o su dirección IP )
Obj_Email.Configuration.Fields(cdoSMTPServer) = SerVidor_SMTP

Obj_Email.Configuration.Fields(cdoSendUsingMethod) = 2

' Puerto. Por defecto se usa el puerto 25, en el caso de Gmail se usan los puertos _
465 o el puerto 587 ( este último me dio error )

Obj_Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(PUERTO)


' Indica el tipo de autentificación con el servidor de correo _
El valor 0 no requiere autentificarse, el valor 1 es con autentificación
Obj_Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _
"configuration/smtpauthenticate") = Abs(Usar_Autentificacion)



' Tiempo máximo de espera en segundos para la conexión
Obj_Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30


' Configura las opciones para el login en el SMTP
If Usar_Autentificacion Then

' Id de usuario del servidor Smtp ( en el caso de gmail, debe ser la dirección de correro _
mas el @gmail.com )
Obj_Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = USUARIO

' Password de la cuenta
Obj_Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = PASSWORD

' Indica si se usa SSL para el envío. En el caso de Gmail requiere que esté en True
Obj_Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = Usar_SSL

End If


' *********************************************************************************
' Estructura del mail
'**********************************************************************************

' Dirección del Destinatario
Obj_Email.To = PARA

' Dirección del remitente
Obj_Email.From = DE

' Asunto del mensaje
Obj_Email.Subject = ASUNTO

' Cuerpo del mensaje
Obj_Email.TextBody = MENSAJE

'Ruta del archivo adjunto

If Path_Adjunto <> vbNullString Then
Obj_Email.AddAttachment (Path_Adjunto)
End If

' Actualiza los datos antes de enviar
Obj_Email.Configuration.Fields.Update

On Error Resume Next
' Envía el email
Obj_Email.Send


If Err.Number = 0 Then
Enviar_Mail_CDO = True
Else
MsgBox Err.Description, vbCritical, " Error al enviar el amil "
End If

' Descarga la referencia
If Not Obj_Email Is Nothing Then
Set Obj_Email = Nothing
End If

On Error GoTo 0
Me.MousePointer = vbNormal

End Function

Private Sub Command1_Click()

Dim ret As Boolean

' Asegurarse de pasar bien los últimos dos parámetros _
( Si usa login y si el server usa SSL)

ret = Enviar_Mail_CDO(txt_Servidor, _
txt_PARA, _
txt_DE, _
txt_ASUNTO, _
txt_ADJUNTO, _
txt_MENSAJE, _
txt_PUERTO, _
txt_USUARIO, _
txt_PASSWORD, _
True, _
True)

' Si devuelve true es por que no hubo errores en el envio

If ret Then
MsgBox " .. Maneje enviado ", vbInformation
End If
End Sub

Private Sub Command2_Click()
'Para el archivo adjunto del Mail
With CommonDialog1

.ShowOpen

If .FileName = "" Then
Exit Sub
End If

txt_ADJUNTO = .FileName

End With

End Sub


Private Sub Command3_Click()
Unload Me
End Sub

Private Sub Form_Load()

Me.Caption = " ENVIO DE CORREOS "
Command1.Caption = " Enviar mail "

txt_Servidor.Text = "smtp.gmail.com"
txt_PARA = ""
txt_DE = ""
txt_ASUNTO = ""
txt_MENSAJE = ""
txt_ADJUNTO = vbNullString
txt_PUERTO.Text = 465
txt_PASSWORD = ""
txt_USUARIO = ""

End Sub


El error de depuración me lo arroja aquí, dice que el protocolo especificado es desconocido

'Ruta del archivo adjunto

If Path_Adjunto <> vbNullString Then
Obj_Email.AddAttachment (Path_Adjunto)
End If

Alguien puede ayudarme no he sabido realmente cual es el problema y he uzado varios otros codigos y nada, agradezco mucho sus respuestas
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder