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

    [Resolvido]Problemano enviar E-mail

    Compartilhe
    avatar
    GCONTABIL
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 138
    Registrado : 17/12/2011

    [Resolvido]Problemano enviar E-mail

    Mensagem  GCONTABIL em Ter 02 Set 2014, 02:46

    Estou utilizando o código para enviar um e-mail mais estar dando erro no .Send, pode verificar o que estar errado. Desde Já agradeço.

    Dim Mens As Object
    Dim Config As Object
    Set Mens = CreateObject("CDO.Message")
    Set Config = CreateObject("CDO.Configuration")


    With Config 'Abrimos o Config para a configuração

       .Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.live.com"  ''Configuramos o servidor smtp
       .Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587 'Configuramos a porta do servidor 'Verifique a porta certa para o seu servidor
       .Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'Configuramos o tipo de cliente. 2 indica uso do Outlook
       .Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'Configuramos o mecanismo de autenticação.
       .Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True 'Configuramos o envio de mensagem segura ou simples, usando True ou False
       .Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "gcontabil@hotmail.com.br" 'Configuramos o email a ser usado para o envio da mensagem
       .Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "senha Email" 'Inserimos a senha do email usado na linha de cima
       .Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60 'Configuramos o tempo da tentativa de conexão

    .Fields.Update 'Atualizamos os campos
    End With

    Set Mens = New CDO.message 'Instanciamos a variável Mens como uma nova mensagem CDO


    With Mens 'Abrimos a variável Mens para receber os dados

    Set .Configuration = Config 'Instanciamos a configuração

    .From = "Notificação CRM Cliente" 'Inserimos o nome ou um título de quem envia

    If Not IsNull(Me.Email) Then 'Não é permitido nulo Email
    .Sender = Me.Email 'Email que será usado para o envio da mensagem
    End If

    'É possível definir um email de resposta que será usado para receber uma resposta quando
    'quem recebeu a mensagem clicar em Responder.

    .ReplyTo = "contgilson@msn.com"

    'É importante fornecer um sistema de codificação de acordo com o idioma.
    .BodyPart.Charset = "utf-8"
    'Aqui, definimos o assunto da mensagem
    .Subject = "txtAssunto"

    'Podemos definir o corpo da mensagem de três formas:

    'Para enviar a mensagem em texto
    '.TextBody = "Me.txtMensagem"

    'Para enviar a mensagem em HTML
    '.HTMLBody = "Me.txtMensagem"

    'Também podemos enviar uma página da Internet, no lugar da mensagem
    .CreateMHTMLBody "http://www.gcontbil.com.br"


    'Aqui, colocamos o email para onde a mensagem deverá ser enviada
    .To = Me.Email


    'Envia a mensagem
    .Send

    'Fechamos a instrução para a variável Mens
    End With

    'Liberamos a variável Mens da memória
    Set Mens = Nothing

    'Liberamos a variável Config da memória
    Set Config = Nothing


    Anexos
    Erro Email.png
    Você não tem permissão para fazer download dos arquivos anexados.
    (16 Kb) Baixado 3 vez(es)
    avatar
    GCONTABIL
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 138
    Registrado : 17/12/2011

    Resolvido

    Mensagem  GCONTABIL em Ter 02 Set 2014, 05:11

    Resolvi o problema com este código:

    Private Sub Enviar_Email_Click()

    Dim Mens As Object
    Dim Config As Object


    Set Mens = CreateObject("CDO.Message")
    Set Config = CreateObject("CDO.Configuration")

    With Config

    .Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" ' stmp do seu servidor
    .Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 ' porta smtp do seu servidor
    .Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True ' True se requer SSL ou False se não requer
    .Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "nfegcontabil@gmail.com" ' Seu usuário ou emial completo
    .Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxx" ' Senha do seu Email
    .Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
    .Fields.Update

    End With

    Set Mens = New CDO.message
    With Mens
    Set .Configuration = Config
    .From = "GContábil" ' Nome do remetente

    .Sender = Me.Email ' Email do destinatário


    .ReplyTo = "contgilson@msn.com" 'Email de resposta
    .BodyPart.Charset = "utf-8" 'É importante fornecer um sistema de codificação de acordo com o idioma.
    'Aqui, definimos o assunto da mensagem

    .Subject = "Interação no CRM nº: " & Me.CRM ' Título da mensagem

    .TextBody = "Olá, " & Me.[Razão Social] & vbCrLf _
    & vbCrLf _
    & "CRM: " & Me.[Ocorrencia] & vbCrLf _
    & "Status: " & Me.CRM_Status & vbCrLf _
    & vbCrLf _
    & "Última interação no CRM: " & Me.[Resposta] & vbCrLf _
    & "Realizado em: " & Me.Dt_final & vbCrLf _
    & vbCrLf _
    & "Atenciosamente," & vbCrLf _
    & vbCrLf _
    & "Gilson Batista de Oliveira" & vbCrLf _
    & "Contador CRC-CE 015890" & vbCrLf _
    & "wwww.gcontabil.com.br" & vbCrLf _
    & "CRM-Customer Relationship Management"


    .To = Me.Email ' Email para o qual a mensagem será enviada

    .Send

    End With

    Set Mens = Nothing
    Set Config = Nothing

    End Sub




      Data/hora atual: Dom 19 Nov 2017, 21:23