Visual Basic - enviar mail desde vb6 con seguridad tls

Life is soft - evento anual de software empresarial
 
Vista:
sin imagen de perfil
Val: 6
Ha disminuido su posición en 14 puestos en Visual Basic (en relación al último mes)
Gráfica de Visual Basic

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
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