Software Público Brasileiro

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CEmail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' Classe responsável pelo envio de emails
'
'
Private emailDestinatario As String             'email de quem vai receber. p.ex. tec@nexusbr.com
Private emailRemetente As String                'nome de quem está enviando. p.ex. NEXUS <tec@nexusbr.com>
Private enderecoSMTP As String                  'endereço smtp de envio. p.ex. para o GMail: smtp.gmail.com
Private portaSMTP As Integer                    'porta de envio do email. p. ex. para o GMail: 465
Private usuarioSMTP As String                   'usuário de login do smtp. p. ex. para o GMail: tec@nexusbr.com
Private senhaSMTP As String                     'senha do sSmtpUser para acessar
Private SslSmtp As Boolean                      'se é para enviar com segurança ou não. p. ex. para o GMail: True

' Envia um email genério
'
' sTo - email de quem vai receber. p.ex. tec@nexusbr.com
' sSubject - texto com o assunto do email
' sFrom - nome de quem está enviando. p.ex. NEXUS <tec@nexusbr.com>
' sBody - texto com o corpo do email
' sSmtpServer - endereço smtp de envio. p.ex. para o GMail: smtp.gmail.com
' iSmtpPort - porta de envio do email. p. ex. para o GMail: 465
' sSmtpUser - usuário de login do smtp. p. ex. para o GMail: tec@nexusbr.com
' sSmtpPword - senha do sSmtpUser para acessar
' sFilePath - caminho do arquivo que será anexado
' bSmtpSSL - se é para enviar com segurança ou não. p. ex. para o GMail: True
'
' Obs.: Ao debugar pode acontecer se estiver indo linha a linha de ele não enviar o email
'
Private Function SendMail(sTo As String, sSubject As String, sFrom As String, _
    sBody As String, sSmtpServer As String, iSmtpPort As Integer, _
    sSmtpUser As String, sSmtpPword As String, _
    sFilePath As String, bSmtpSSL As Boolean) As String
      
    On Error GoTo SendMail_Error:
    Dim lobj_cdomsg      As CDO.message             'Entrar em Project References e incluir a biblioteca cdosys.dll
    Set lobj_cdomsg = New CDO.message
    lobj_cdomsg.Configuration.Fields(cdoSMTPServer) = sSmtpServer
    lobj_cdomsg.Configuration.Fields(cdoSMTPServerPort) = iSmtpPort
    lobj_cdomsg.Configuration.Fields(cdoSMTPUseSSL) = bSmtpSSL
    lobj_cdomsg.Configuration.Fields(cdoSMTPAuthenticate) = cdoBasic
    lobj_cdomsg.Configuration.Fields(cdoSendUserName) = sSmtpUser
    lobj_cdomsg.Configuration.Fields(cdoSendPassword) = sSmtpPword
    lobj_cdomsg.Configuration.Fields(cdoSMTPConnectionTimeout) = 30
    lobj_cdomsg.Configuration.Fields(cdoSendUsingMethod) = cdoSendUsingPort
    lobj_cdomsg.Configuration.Fields.Update
    lobj_cdomsg.To = sTo
    lobj_cdomsg.From = sFrom
    lobj_cdomsg.Subject = sSubject
    lobj_cdomsg.TextBody = sBody
    If Trim$(sFilePath) <> vbNullString Then
        lobj_cdomsg.AddAttachment (sFilePath)
    End If
    lobj_cdomsg.Send
    Set lobj_cdomsg = Nothing
    SendMail = "ok"
    Exit Function
          
SendMail_Error:
    SendMail = Err.Description
End Function
' Metodo para enviar uma mensagem de erro que ocorreu no GeoSan
'
' arquivoParaEnviar - nome do arquivo completo a ser enviado em anexo ao email. p. ex. C:\user\pinheiro\geosanLogErro.txt
'
Public Function enviaEmail(arquivoParaAnexar As String) 'As String
    Dim retval As String
    Dim textoErro As String
    
    textoErro = "Segue em anexo o arquivo de log do erro ocorrido no GeoSan."
    retval = SendMail(emailDestinatario, "GeoSan - Aviso de erro", emailRemetente, textoErro, enderecoSMTP, portaSMTP, usuarioSMTP, senhaSMTP, arquivoParaAnexar, SslSmtp)
    enviaEmail = retval
End Function
' Método para ler as configurações de envio de email
'
'
Public Function leConfiguracoesEmail()
    Dim caminhoGeoSanIni As String
    
    caminhoGeoSanIni = App.path & "\CONTROLES\GEOSAN.INI"
    emailDestinatario = ReadINI("EMAIL", "EMAILDESTINATARIO", caminhoGeoSanIni)
    emailRemetente = ReadINI("EMAIL", "EMAILREMETENTE", caminhoGeoSanIni)
    enderecoSMTP = ReadINI("EMAIL", "ENDERECOSMTP", caminhoGeoSanIni)
    portaSMTP = CInt(IIf(ReadINI("EMAIL", "PORTASMTP", caminhoGeoSanIni) = "", 0, ReadINI("EMAIL", "PORTASMTP", caminhoGeoSanIni)))     'caso não encontre retorna a porta zero
    usuarioSMTP = ReadINI("EMAIL", "USUARIOSMTP", caminhoGeoSanIni)
    senhaSMTP = ReadINI("EMAIL", "SENHASMTP", caminhoGeoSanIni)
    SslSmtp = CBool(IIf(ReadINI("EMAIL", "SSLSMTP", caminhoGeoSanIni) = "", "TRUE", ReadINI("EMAIL", "SSLSMTP", caminhoGeoSanIni)))     'caso exista erro na leitura da segurança ssl, define como padrão TRUE, senão o que foi entrado no arquivo .ini
    If emailDestinatario = "" Or emailRemetente = "" Or enderecoSMTP = "" Or portaSMTP = 0 Or usuarioSMTP = "" Or senhaSMTP = "" Then   'define como padrão o email da NEXUS, pois não consegui ler corretamente no arquivo .ini
        emailDestinatario = "tec@nexusbr.com"
        emailRemetente = "NEXUS <tec@nexusbr.com>"
        enderecoSMTP = "smtp.gmail.com"
        portaSMTP = 465
        usuarioSMTP = "tec@nexusbr.com"
        senhaSMTP = "nexus243"
        SslSmtp = True
    Else
        'conseguiu ler com sucesso todas informações e está pronto para enviar emails caso ocorra um erro na aplicação
    End If
End Function