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


    Enviar Email com CDO

    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3911
    Registrado : 06/11/2009

    Enviar Email com CDO Empty Enviar Email com CDO

    Mensagem  Assis em 11/5/2019, 10:57

    Bo dia Amigos

    Uso o código abaixo para enviar emails com CDO.

    Mas se o mail não for enviado ele é gravado numa tabela de mails enviados.


    Como só gravar o mail na tabela depois de ser enviado

    Obrigado



    Código:
    Dim BancoDeDados As dao.Database
    Dim TabLan?amentos As Recordset
    Dim Confirma


    Confirma = MsgBox("Confirma o Envio do Mail Para ?" & vbCrLf & Me.Texto38 & "", vbYesNo, "Gestão de @Mails")
    If Confirma = vbYes Then
    DoCmd.SetWarnings False
    DoCmd.RunCommand acCmdSpelling
    DoCmd.SetWarnings True
       'Inserindo o mail
       Set BancoDeDados = CurrentDb
       Set TabLan?amentos = BancoDeDados.OpenRecordset("Enviados")
       
           With TabLan?amentos
               .AddNew
               !TData = Date
               !Para = Me.txtPara
               !Nome = Me.txtDeMail
               !Assunto = Me.txtAssunto
               !Anexo = Me.txtAnexo
               !Anexo1 = Me.txtAnexo1
               !Anexo2 = Me.txtAnexo2
               !Mensagem = Me.txtMensagem
               !HoraEnvio = Time
               !Servidor = DLookup("Servidor", "DadosProprietario")
               .Update
           End With
     

    Call EnviarEmail

    Final:


    Else
    MsgBox "Cancelar Gravação do Mail ?", vbCritical, "@Mail não será Enviado"
     
         Call btnLimpar_Click

       Me.txtPara.SetFocus
     
    End If


    End Sub

    -------------------------------------------------------------------------------------------------------------------------------------
    Sub EnviarEmail()
       
       Set emailobj = CreateObject("CDO.Message")
       
       emailobj.From = Me.Email
       emailobj.To = Me.txtPara
       emailobj.Subject = Me.txtAssunto
       emailobj.TextBody = Me.txtMensagem
       
       Set emailConfig = emailobj.Configuration
           
       emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
       emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
       emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
       emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = DLookup("smtp", "DadosProprietario")
       emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = DLookup("porta", "DadosProprietario")
       emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
       emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = DLookup("email", "DadosProprietario")
       emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = DLookup("pass", "DadosProprietario")
       emailConfig.Fields.Update
       

    If Not IsNull(Me.txtAnexo) Then
    emailobj.AddAttachment (Me.txtAnexo)
    End If
    If Not IsNull(Me.txtAnexo1) Then
    emailobj.AddAttachment (Me.txtAnexo1)
    End If
    If Not IsNull(Me.txtAnexo2) Then
    emailobj.AddAttachment (Me.txtAnexo2)
    End If


    DoCmd.OpenForm "frmProgresso"

     emailobj.Send
     
       If err.Number = 0 Then MsgBox "@Mail Enviado com Sucesso", vbExclamation, "Gest?o de @Mails"

       DoCmd.Close acForm, "frmProgresso"

       DoCmd.Close acForm, "email"
       
       Set emailobj = Nothing
       Set emailConfig = Nothing



    End Sub


    .................................................................................
    *** Só sei que nada sei ***
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6308
    Registrado : 15/03/2013

    Enviar Email com CDO Empty Re: Enviar Email com CDO

    Mensagem  ahteixeira em 11/5/2019, 11:44

    Bom dia Assis,

    A usar acentuação em nome de variáveis, nem queria acreditar.
    O que fiz foi alterar a parte que "grava" para depois do IF que verifica se deu erro no envio e mostra a caixa de mensagem.
    A parte que "grava" abria o "Recordset" mas não fechava no fim,  mais atenção nesses códigos amigo.

    Veja se é isto:
    Código:
    Option Compare Database

    Dim BancoDeDados As dao.Database
    Dim TabLancamentos As Recordset
    Dim Confirma

    Confirma = MsgBox("Confirma o Envio do Mail Para ?" & vbCrLf & Me.Texto38 & "", vbYesNo, "Gestão de @Mails")

        If Confirma = vbYes Then
            DoCmd.SetWarnings False
            DoCmd.RunCommand acCmdSpelling
            DoCmd.SetWarnings True
           'Inserindo o mail
           '---Codigo retirado daqui ----
        Call EnviarEmail
    Final:
        Else
            MsgBox "Cancelar Gravação do Mail ?", vbCritical, "@Mail não será Enviado"
            Call btnLimpar_Click
            Me.txtPara.SetFocus
        End If
    End Sub

    Sub EnviarEmail()
      
        Set emailobj = CreateObject("CDO.Message")
        
        emailobj.From = Me.Email
        emailobj.To = Me.txtPara
        emailobj.Subject = Me.txtAssunto
        emailobj.TextBody = Me.txtMensagem
        
        Set emailConfig = emailobj.Configuration
            
        emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
        emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = DLookup("smtp", "DadosProprietario")
        emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = DLookup("porta", "DadosProprietario")
        emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = DLookup("email", "DadosProprietario")
        emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = DLookup("pass", "DadosProprietario")
        emailConfig.Fields.Update
      

        If Not IsNull(Me.txtAnexo) Then emailobj.AddAttachment (Me.txtAnexo)
        If Not IsNull(Me.txtAnexo1) Then emailobj.AddAttachment (Me.txtAnexo1)
        If Not IsNull(Me.txtAnexo2) Then emailobj.AddAttachment (Me.txtAnexo2)
        
        DoCmd.OpenForm "frmProgresso"
        
        emailobj.Send
        
        '--- If ajustado e colocado o codigo se seguir
        If err.Number = 0 Then
                Set BancoDeDados = CurrentDb
                Set TabLancamentos = BancoDeDados.OpenRecordset("Enviados")
          
               With TabLancamentos
                   .AddNew
                   !TData = Date
                   !Para = Me.txtPara
                   !Nome = Me.txtDeMail
                   !Assunto = Me.txtAssunto
                   !Anexo = Me.txtAnexo
                   !Anexo1 = Me.txtAnexo1
                   !Anexo2 = Me.txtAnexo2
                   !Mensagem = Me.txtMensagem
                   !HoraEnvio = Time
                   !Servidor = DLookup("Servidor", "DadosProprietario")
                   .Update
               End With
              
               'adicionado codigo abaixo pois faltava fechar o recordset e base dados
                TabLancamentos.Close
                Set TabLancamentos = Nothing
                Set BancoDeDados = Nothing
                '--------
                
            MsgBox "@Mail Enviado com Sucesso", vbExclamation, "Gest?o de @Mails"
        End If

        DoCmd.Close acForm, "frmProgresso"
        
        DoCmd.Close acForm, "email"
        
        Set emailobj = Nothing
        Set emailConfig = Nothing
    End Sub

    Abraço
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3911
    Registrado : 06/11/2009

    Enviar Email com CDO Empty Re: Enviar Email com CDO

    Mensagem  Assis em 11/5/2019, 13:33

    Teixeira

    Testei alterando o email do destinatário (coloquei  anibal.assis@sapo.ptt ),   e deu erro de envio mas gravou igual na tabela.


    .................................................................................
    *** Só sei que nada sei ***
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6308
    Registrado : 15/03/2013

    Enviar Email com CDO Empty Re: Enviar Email com CDO

    Mensagem  ahteixeira em 11/5/2019, 15:51

    Olá Assis,

    Foi a "olho" que fiz alteração.
    Se registou, então também mostrou a mensgem a dizer que foi enviado.
    Apenas ajustei ao codigo apresentado.

    Verifique se tem tratamento de erro a funcionar.
    O Assis usa muito o on error resume next e se for o caso não vai funcionar.
    Estou no telemóvel, mas a única forma de só gravar quando enviar, precisa de ter um identificador se a mensagem foi enviada sem erro.

    Tente pesquisar.

    Abraço
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3911
    Registrado : 06/11/2009

    Enviar Email com CDO Empty Re: Enviar Email com CDO

    Mensagem  Assis em 11/5/2019, 16:22

    Teixeira

    Sim mesmo assim informa que o mail foi enviado

    Retirei o On Error Resume Next e é igual

    Obrigado


    .................................................................................
    *** Só sei que nada sei ***
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6308
    Registrado : 15/03/2013

    Enviar Email com CDO Empty Re: Enviar Email com CDO

    Mensagem  ahteixeira em 11/5/2019, 16:51

    Olá Assis,

    Estou sem PC mas estive a pesquisar.
    Repare, uma coisa é o código dar erro no envio (que pelos vistos não é o caso)
    Outra coisa é não dar erro ao enviar, mas depois chegou ao destino e não existe o email e o servidor de e-mail dá erro de resposta a quem enviou.

    Vou meditar no assunto e aguardamos se algum colega tem alguma sugestão.

    Não creio que vá resolver, mas teste com a primeira opção de tratamento de erros
    http://www.maximoaccess.com/t30190-opcao-error-trapping-interceptacao-de-erro

    Abraço
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3911
    Registrado : 06/11/2009

    Enviar Email com CDO Empty Re: Enviar Email com CDO

    Mensagem  Assis em 11/5/2019, 17:42

    Igual


    .................................................................................
    *** Só sei que nada sei ***
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Enviar Email com CDO Empty Re: Enviar Email com CDO

    Mensagem  Alexandre Neves em 9/6/2019, 14:40

    Boa tarde, Assis
    Ainda está por resolver?


    .................................................................................
    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
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3911
    Registrado : 06/11/2009

    Enviar Email com CDO Empty Re: Enviar Email com CDO

    Mensagem  Assis em 10/6/2019, 09:25

    Bom dia Alexandre

    Sim igual.





    .................................................................................
    *** Só sei que nada sei ***
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Enviar Email com CDO Empty Re: Enviar Email com CDO

    Mensagem  Alexandre Neves em 10/6/2019, 09:46

    Bom dia, Assis
    Mude o procedimento de envio para função
    passa de sub Envia para função (Function EnviaCE(argumentos)as boolean)
    onde tem err=0 acrescentas EnviaCE=True

    Ao executar a função, ele devolve Sim ou Não e a partir daí dá para gerir o que pretende fazer a seguir
    Se precisares que tente adaptar o teu código dá um alerta


    .................................................................................
    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
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6308
    Registrado : 15/03/2013

    Enviar Email com CDO Empty Re: Enviar Email com CDO

    Mensagem  ahteixeira em 12/6/2019, 20:04

    Olá a todos,

    Alexandre o colega Assis, pediu ajuda (MP) para implementar a ideia da mensagem n. 10
    Creio que seja dentro disto com base o código da mensagem n. 1:
    Código:
    Sub QueNaoSabemosNomeDoSeuProjeto()

    Dim BancoDeDados As dao.Database
    Dim TabLancamentos As Recordset
    Dim Confirma

        Confirma = MsgBox("Confirma o Envio do Mail Para ?" & vbCrLf & Me.Texto38 & "", vbYesNo, "Gestão de @Mails")
        If Confirma = vbYes Then
        DoCmd.SetWarnings False
        DoCmd.RunCommand acCmdSpelling
        DoCmd.SetWarnings True
        
        If EnviaCE = True Then 'alteracao
           'Inserindo o mail
           Set BancoDeDados = CurrentDb
           Set TabLancamentos = BancoDeDados.OpenRecordset("Enviados")
          
               With TabLancamentos
                   .AddNew
                   !TData = Date
                   !Para = Me.txtPara
                   !Nome = Me.txtDeMail
                   !Assunto = Me.txtAssunto
                   !Anexo = Me.txtAnexo
                   !Anexo1 = Me.txtAnexo1
                   !Anexo2 = Me.txtAnexo2
                   !Mensagem = Me.txtMensagem
                   !HoraEnvio = Time
                   !Servidor = DLookup("Servidor", "DadosProprietario")
                   .Update
               End With
            
             'Call EnviarEmail passou para if com fincao nova

            'Assis acho deveria fechar o recordset
            TabLancamentos.Close
            Set TabLancamentos = Nothing
        End If
    Final:
        Else
            MsgBox "Cancelar Gravação do Mail ?", vbCritical, "@Mail não será Enviado"
            Call btnLimpar_Click
            Me.txtPara.SetFocus
          
        End If
    End Sub

    Function EnviaCE() As Boolean

        Set emailobj = CreateObject("CDO.Message")
        
        emailobj.From = Me.Email
        emailobj.To = Me.txtPara
        emailobj.Subject = Me.txtAssunto
        emailobj.TextBody = Me.txtMensagem
        
        Set emailConfig = emailobj.Configuration
            
        emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
        emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = DLookup("smtp", "DadosProprietario")
        emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = DLookup("porta", "DadosProprietario")
        emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = DLookup("email", "DadosProprietario")
        emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = DLookup("pass", "DadosProprietario")
        emailConfig.Fields.Update
      

        If Not IsNull(Me.txtAnexo) Then
            emailobj.AddAttachment (Me.txtAnexo)
        End If
        
        If Not IsNull(Me.txtAnexo1) Then
            emailobj.AddAttachment (Me.txtAnexo1)
        End If
        
        If Not IsNull(Me.txtAnexo2) Then
            emailobj.AddAttachment (Me.txtAnexo2)
        End If


        DoCmd.OpenForm "frmProgresso"
        
        emailobj.Send
     
        If Err.Number = 0 Then MsgBox "@Mail Enviado com Sucesso", vbExclamation, "Gestão de @Mails": EnviaCE = True  'alteracao
        
        DoCmd.Close acForm, "frmProgresso"
        
        DoCmd.Close acForm, "email"
        
        Set emailobj = Nothing
        Set emailConfig = Nothing

    End Function

    Assis, o colega Alexandre Neves não tem MP ativado, mas era só fazer como referiu "Se precisares que tente adaptar o teu código dá um alerta" no tópico.

    cheers
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Enviar Email com CDO Empty Re: Enviar Email com CDO

    Mensagem  Alexandre Neves em 12/6/2019, 22:16

    Boa noite,
    É dentro disso amigo Teixeira
    Com esse resultado da função EnviaCE, caso seja True a mensagem foi enviada e fará o tratamento de registo pretendido, caso contrário, considera não enviada a mensagem


    .................................................................................
    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
    Assis
    Assis
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 3911
    Registrado : 06/11/2009

    Enviar Email com CDO Empty Re: Enviar Email com CDO

    Mensagem  Assis em 13/6/2019, 21:59

    Boa noite Amigos

    Devia dar erro ao detetar erro no email do destinatário (coloquei  anibal.assis@sapo.ptt )

    O final do endereço coloco errado  de propósito e não deteta .


    Continua a informar a  MsgBox "@Mail Enviado com Sucesso"

    Obrigado


    .................................................................................
    *** Só sei que nada sei ***
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6308
    Registrado : 15/03/2013

    Enviar Email com CDO Empty Re: Enviar Email com CDO

    Mensagem  ahteixeira em 14/6/2019, 08:36

    Bom dia Amigos

    Assis, como ja referi, o codigo não dá erro de envio o "cdo" enviou o email sem qualquer erro.
    Como enviou para um email inexistente, neste caso o servidor de recepção de email da sapo, vai responder com uma mensagem automática para o servidor que enviou e por sua vez ao respetivo email que enviou.

    Portanto a meu ver a única forma séria verificar as mensagens recebidas na caixa de email.

    Aguardamos se algum colega tem outra opinião e solução.

    Abraço a todos

    Conteúdo patrocinado

    Enviar Email com CDO Empty Re: Enviar Email com CDO

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 21/9/2019, 17:01