enviar mail desde vb6 con seguridad tls
Publicado por Alejandro Nicolas (4 intervenciones) el 13/09/2022 02:49:12
Buen día colegas, tengo un sistema desarrollado en vb6 que funciona perfecto enviando mail desde los informes con adjuntos en pdf o excel, resulta que el isp de un cliente, cambió la configuración de seguridad a TLS. y ya no me envía los mails. Alguien que me ueda aconsejar o corregir mi función:
Function Enviar() As Boolean
Dim oCDO As Object
If InternetGetConnectedState(0&, 0&) = False Then
RaiseEvent Error("No se puede enviar el correo. " & "Verificar la conexión a internet si está disponible", 0)
Exit Function
End If
If Not IsNumeric(puerto) Then
RaiseEvent Error("No se ha indicado el puerto del servidor", 0)
Exit Function
End If
Set oCDO = CreateObject("CDO.Message")
oCDO.Configuration.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
oCDO.Configuration.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mServidor
oCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = mPuerto
If mUseAuntentificacion Then
oCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
oCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mUsuario
oCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mPassword
If mSSL = True Then
oCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = mSSL
ElseIf mTLS = True Then
oCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendtls").Value = mTLS
End If
Else
oCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 0
End If
oCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
oCDO.To = mPara
oCDO.From = mDe
oCDO.Subject = mAsunto
oCDO.TextBody = mMensaje
If mAdjunto1 <> "" Then
If Len(Dir(mAdjunto1)) = 0 Then
' ..error
RaiseEvent Error("No se ha encontrado el archivo en la siguiente ruta: ", 0)
Exit Function
Else
' ..lo agrega
oCDO.AddAttachment (mAdjunto1)
End If
End If
If mAdjunto2 <> "" Then
If Len(Dir(mAdjunto2)) = 0 Then
' ..error
RaiseEvent Error("No se ha encontrado el archivo en la siguiente ruta: ", 0)
Exit Function
Else
' ..lo agrega
oCDO.AddAttachment (mAdjunto2)
End If
End If
oCDO.Configuration.Fields.Update
On Error Resume Next
oCDO.Send
If Err.Number = 0 Then
Enviar_Backup = True
RaiseEvent EnvioCompleto
Else
RaiseEvent Error(Err.Description, Err.Number)
End If
If Not oCDO Is Nothing Then
Set oCDO = Nothing
End If
Err.Clear
End Function
Muchas gracias
Function Enviar() As Boolean
Dim oCDO As Object
If InternetGetConnectedState(0&, 0&) = False Then
RaiseEvent Error("No se puede enviar el correo. " & "Verificar la conexión a internet si está disponible", 0)
Exit Function
End If
If Not IsNumeric(puerto) Then
RaiseEvent Error("No se ha indicado el puerto del servidor", 0)
Exit Function
End If
Set oCDO = CreateObject("CDO.Message")
oCDO.Configuration.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
oCDO.Configuration.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mServidor
oCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = mPuerto
If mUseAuntentificacion Then
oCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
oCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mUsuario
oCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mPassword
If mSSL = True Then
oCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = mSSL
ElseIf mTLS = True Then
oCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendtls").Value = mTLS
End If
Else
oCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 0
End If
oCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
oCDO.To = mPara
oCDO.From = mDe
oCDO.Subject = mAsunto
oCDO.TextBody = mMensaje
If mAdjunto1 <> "" Then
If Len(Dir(mAdjunto1)) = 0 Then
' ..error
RaiseEvent Error("No se ha encontrado el archivo en la siguiente ruta: ", 0)
Exit Function
Else
' ..lo agrega
oCDO.AddAttachment (mAdjunto1)
End If
End If
If mAdjunto2 <> "" Then
If Len(Dir(mAdjunto2)) = 0 Then
' ..error
RaiseEvent Error("No se ha encontrado el archivo en la siguiente ruta: ", 0)
Exit Function
Else
' ..lo agrega
oCDO.AddAttachment (mAdjunto2)
End If
End If
oCDO.Configuration.Fields.Update
On Error Resume Next
oCDO.Send
If Err.Number = 0 Then
Enviar_Backup = True
RaiseEvent EnvioCompleto
Else
RaiseEvent Error(Err.Description, Err.Number)
End If
If Not oCDO Is Nothing Then
Set oCDO = Nothing
End If
Err.Clear
End Function
Muchas gracias
Valora esta pregunta


0