Enviar Email pelo EXCEL

[paulocezarpicos]

Galera,

Estou precisando da ajuda de vocês. Estou usando uma planilha que envia um arquivo via email direto do EXCEL, só que quando estou usando uma maquina nova (DELL), Office 2016, funciona beleza, mas quando tento usar a mesma planilha numa maquina antiga (HP) aparece o seguinte erro: ERRO EM TEMPO DE EXECUÇÃO '-2147220973(80040213)': FALHA NA CONEXÃO DO TRANSPORTE COM SERVIDOR.

 

Agradeceria muito se alguém me desse uma luz.

 

Obs.: planilha em anexo.

 

Paulo Cezar.

 

A seguir a formula que estou usando:

 

Function EnviaEmail()

' Progress Blips
'
    Dim intIndex As Integer
    Dim sngPercent As Single
    Dim intMax As Integer
    
    intMax = 60
    For intIndex = 1 To intMax
        sngPercent = intIndex / intMax
        ProgressStyle5 sngPercent
        ProgressStyle6 sngPercent
        DoEvents
     
        Sleep 60
    Next

    Dim iMsg, iConf, Flds, nome, schema, SendEmailGmail
    nome = [D1].Value & ".pdf"
    'Seta as variáveis, lembrando que o objeto Microsoft CDO deverá estar habilitado em Ferramentas->Referências->Microsoft CDO for Windows 2000 Library
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    Set Flds = iConf.Fields
    
    'Configura o componente de envio de email
    schema = "http://schemas.microsoft.com/cdo/configuration/"
    Flds.item(schema & "sendusing") = 2
    'Configura o smtp
    Flds.item(schema & "smtpserver") = "smtp.gmail.com"
    'Configura a porta de envio de email
    Flds.item(schema & "smtpserverport") = 465
    Flds.item(schema & "smtpauthenticate") = 1
    'Configura o email do remetente
    Flds.item(schema & "sendusername") = "[email protected]"
    'Configura a senha do email remetente
    Flds.item(schema & "sendpassword") = "picos123"
    Flds.item(schema & "smtpusessl") = 1
    Flds.Update
 
    With iMsg
        'Email do destinatário
        
        .To = Sheets("Dados").Range("G3").Value    'EMAIL DO DESTINATÁRIO

        'Seu email
        .From = "[email protected]"
        'Título do email
        .Subject = "Envio de TRAFOS QUEIMADOS " & Sheets("formulario").Range("T74").Value & " - " & Sheets("formulario").Range("T75").Value
        'Mensagem do e-mail, você pode enviar formatado em HTML
        .HTMLBody = "Paulo Cézar, em anexo estamos enviando FICHA de TRAFO QUEIMADO de " & Sheets("formulario").Range("T74").Value & " - " & Sheets("formulario").Range("T75").Value
        'Seu nome ou apelido
        .Sender = "Teste"
        'Nome da sua organização
        .Organization = "Empresa Teste"
        'email de responder para
        .ReplyTo = "[email protected]"
        'Anexo a ser enviado na mensagem
        .AddAttachment ("c:\TRAFOS SUBSTITUIDOS\TRAFOS\" & Sheets("Formulario").Range("T74").Value & ".pdf")
        'Passa a configuração para o objeto CDO
        Set .Configuration = iConf
        'Envia o email
        SendEmailGmail = .Send
    End With
 
    'Limpa as variáveis
    Set iMsg = Nothing
    Set iConf = Nothing
    Set Flds = Nothing
    
Sheets("Banco de Dados").Select

End Function
 

Cadastramento e Envio de TRAFOS Substituidos.zip