MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Problema com Senvio de E-mail via CDO

    Compartilhe

    Solver
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2
    Registrado : 14/06/2017

    Problema com Senvio de E-mail via CDO

    Mensagem  Solver em Qua 14 Jun 2017, 13:50

    Bom Dia,

    Estou com problemas para envio de e-mail usando CDO, que não consegui identificar claramente. Na minha máquina, enviar corretamente porém em uma máquina ao lado da minha, o e-mail não sai. Percebi que eu estava usando o "on error resume next" e por isto não acusava nenhum erro, acrescentei o código abaixo para obter o erro:
    If Err <> 0 Then
    'Response.Write "Ocorreu um Erro: " & Err.Description
    End If

    Depois deste acréscimo surgiu a mensagem: "erro 424 - Objeto Não Encontrado"

    Alguém já passou por isto?

    Obrigado!
    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6496
    Registrado : 05/11/2009

    Re: Problema com Senvio de E-mail via CDO

    Mensagem  Alexandre Neves em Qua 14 Jun 2017, 14:09

    Boa tarde, e bem-vindo ao fórum
    Mostre o código todo do envio


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo

    Solver
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2
    Registrado : 14/06/2017

    Re: Problema com Senvio de E-mail via CDO

    Mensagem  Solver em Qua 14 Jun 2017, 14:30

    Olá Alexandre,

    Segue o código completo

    Sub Enviar_Email(ByRef Form As String)
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Destinatarios As String
    Dim Copiatarios As String
    Dim Flds As Variant
    Dim ColDest As Integer
    Dim LastDest As Integer
    Dim ColCop As Integer
    Dim LastCop As Integer

    'Identifica se é Ocorrência com Funcionário ou Terceiro para colcoar o texto correto.
    If Form = "Funcionário" Then
    strbody = "ATENÇÃO" & vbNewLine & vbNewLine & _
    "Você está recebendo esta Mensagem porque uma Ocorrência foi cadastrada!!" & vbNewLine & vbNewLine & _
    "Ocorrência: " & frmCadastrosocorrencias.cboOcorrencia.Value & vbNewLine & _
    "Quanto à Afastamento: " & frmCadastrosocorrencias.cboTipoocorrencia.Value & _
    vbNewLine & vbNewLine & _
    "Ocorrencia Número " & frmCadastrosocorrencias.cboCodigoacidente.Value & " com o Funcionário " & frmCadastrosocorrencias.txtNome.Value & _
    vbNewLine & vbNewLine & _
    "Descrição Preliminar: " & frmCadastrosocorrencias.txtDescricao & vbNewLine & vbNewLine & _
    "Acesse o Smart Prevent e Verifique!!" & vbNewLine & vbNewLine & _
    "Smart Prevent - Prevenir é a Melhor Alternativa"
    Else
    strbody = "ATENÇÃO" & vbNewLine & vbNewLine & _
    "Você está recebendo esta Mesagem porque uma Ocorrência com Terceiros foi cadastrada!!" & vbNewLine & vbNewLine & _
    "Ocorrencia Número " & frmCadastrosocorrenciasT.cboCodigoacidente.Value & " com o Terceiro " & frmCadastrosocorrenciasT.txtNome.Value & _
    vbNewLine & vbNewLine & _
    "Descrição Preliminar: " & frmCadastrosocorrenciasT.txtDescricao & vbNewLine & vbNewLine & _
    "Acesse o Smart Prevent e Verifique!!" & vbNewLine & vbNewLine & _
    "Smart Prevent - Prevenir é a Melhor Alternativa"
    End If

    'Identifica número da coluna de Destinatários e Copiatários para o E-mail
    Call Identifica_Coluna("Destinatarios", ThisWorkbook.Worksheets("Listas"))
    ColDest = ColunaLista
    Call Identifica_Coluna("Copiatarios", ThisWorkbook.Worksheets("Listas"))
    ColCop = ColunaLista
    'Identifica final das listas de destinatários e copiatários
    ThisWorkbook.Worksheets("Listas").Activate
    LastDest = Application.WorksheetFunction.CountA(Columns(ColDest))
    LastCop = Application.WorksheetFunction.CountA(Columns(ColCop))

    'Monta Lista de Destinatários
    Destinatarios = ""
    For iCounter = 2 To LastDest
    If Destinatarios = "" Then
    Destinatarios = Cells(iCounter, ColDest).Value
    Else
    Destinatarios = Destinatarios & ";" & Cells(iCounter, ColDest).Value
    End If
    Next iCounter

    'Monta Lista de Copiatários
    Copiatarios = ""
    For iCounter = 2 To LastCop
    If Copiatarios = "" Then
    Copiatarios = Cells(iCounter, ColCop).Value
    Else
    Copiatarios = Copiatarios & ";" & Cells(iCounter, ColCop).Value
    End If
    Next iCounter

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

    iConf.Load -1 ' CDO Source Defaults
    Set Flds = iConf.Fields
    On Error GoTo Saida
    With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "meuservido" - Aqui coloco o meu servidor
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    .Update
    End With
    With iMsg
    Set .Configuration = iConf
    .To = Destinatarios
    .CC = Copiatarios
    .BCC = ""
    .From = """Smart Prevent"" " - Aqui coloco o e-mail de quem está enviando, no meu caso, uma conta genérica
    .Subject = "Aviso: Nova Ocorrência Cadastrada - Número " & frmCadastrosocorrencias.cboCodigoacidente.Value
    .TextBody = strbody
    .Send
    End With
    Saida:
    If Err <> 0 Then
    'Response.Write "Ocorreu um Erro: " & Err.Description
    End If
    Set iMsg = Nothing
    Set iConf = Nothing
    Set Flds = Nothing
    End Sub

      Data/hora atual: Sab 18 Nov 2017, 01:07