MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

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

3 participantes

    [Resolvido]Emails automáticos

    gabrielpn06
    gabrielpn06
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 180
    Registrado : 17/01/2017

    [Resolvido]Emails automáticos Empty [Resolvido]Emails automáticos

    Mensagem  gabrielpn06 21/8/2017, 17:37

    Boa tarde amigos,
    Editei alguns exemplos que achei para realizar o envio de e-mails automáticos incluindo alguns anexos, porém não obtive sucesso.
    Poderiam dizer o que há de errado com meu código? Desde já agradeço!

    Código:
    Private Sub Comando71_Click()

        Dim escritorio As String
        Dim mensagem As String
        Dim email As Object
        Dim appOutlook As Object
        Dim olMail As Object
        Dim rst As DAO.Recordset
        Dim strDestinatarios
        
        Beep
        If MsgBox("Deseja Enviar o e-mail? Não esqueça de deixar o outlook aberto!", vbInformation + vbYesNo, "Atenção") = vbYes Then
        
        'Verifica se Outlook está aberto. Caso não esteja, criar nova instância
        Set appOutlook = GetObject(, "Outlook.Application")
        If appOutlook Is Nothing Then
        Set appOutlook = CreateObject("Outlook.Application")
        End If
        On Error GoTo 0

        '0 é um item de e-mail
        Set olMail = appOutlook.CreateItem(0)
        
        'Define o nome da consulta onde estarão cadastrados os emails autorizados
        Set rst = CurrentDb.OpenRecordset("Cs_Emails_Autorizados")
        Do Until rst.EOF
        strDestinatarios = strDestinatarios & rst("eMail") & ";"
        rst.MoveNext
        Loop
        strDestinatarios = Left(strDestinatarios, Len(strDestinatarios) - 1)
        
        'Select Case escritorio

           ' Case "ANTONIO"
                With olMail
          
                    .To = "gabriel.p.lisboa@outlook.com"
                    .CC = "vg.cordeiro@outlook.com"
                    .Subject = "E-mail 1 - ANTONIO FERNANDO DE SOUZA E GARCIA DE SOUZA A - PR"
                    .Body = "Bom dia, segue anexo referente a email automatizado  1" & " " & Date & " - " & Time()
                    .Attachments.Add CurrentProject.Path & "\Export\ANTONIO.xlsm"
                End With
        
            Case "AREAS"
                With olMail
          
                    .To = "gabriel.p.lisboaoutlook.com"
                    .CC = "vg.cordeiro@outlook.com"
                    .Subject = "E-mail 2 - AREAS ASSESSORIA JURIDICA"
                    .Body = "Bom dia, segue anexo referente a email automatizado 2" & " " & Date & " - " & Time()
                    .Attachments.Add CurrentProject.Path & "\Export\ARÊAS.xlsm"
                    End With
        
            Case "BASILIO"
                With olMail
          
                    .To = "gabriel.p.lisboaoutlook.com"
                    .CC = "vg.cordeiro@outlook.com"
                    .Subject = "E-mail 3 - BASILIO, DI MARINO E FARIA ADVOGADOS - RJ"
                    .Body = "Bom dia, segue anexo referente a email automatizado 3" & " " & Date & " - " & Time()
                    .Attachments.Add CurrentProject.Path & "\Export\BASILIO.xlsm"
                    End With

            Case Else
                    MsgBox "Email não enviado!"
          
          
            End Select
            
          Else: GoTo saída

          rst.Close
          Set rst = Nothing

          End If

         saída: Exit Sub

          MsgBox "E-mails enviados com sucesso!", vbInformation

    End Sub
    avatar
    joaomarcos84712722
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 10
    Registrado : 17/03/2017

    [Resolvido]Emails automáticos Empty Emails Automáticos

    Mensagem  joaomarcos84712722 17/9/2017, 04:30

    O que acontece quando você executa esse código?
    CassioFabre
    CassioFabre
    Super Avançado
    Super Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 731
    Registrado : 18/01/2013

    [Resolvido]Emails automáticos Empty Re: [Resolvido]Emails automáticos

    Mensagem  CassioFabre 18/9/2017, 20:46

    Boa tarde,

    Eu prefiro utilizar o CDOSys para enviar e-mails, sejam automáticos ou não. Isso porque nem sempre pode ser que o usuário tenha o Outlook instalado na máquina. Abaixo um pequeno exemplo que utilizo no meu programa para recuperção automática de senha pelo usuário, através do formulário de login:

    Código:
    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") = rs!smtp
            .Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = rs!porta
            .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
            .Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = rs!email
            .Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = fncCrip(rs!senha, 102030)
            .Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
            
            .Fields.Update
        End With
        
        Set Mens = New CDO.Message
        With Mens
            Set .Configuration = Config
            .From = rs!nome
            .Sender = rs!email
                
            .BodyPart.charset = "utf-8"
            .Subject = strAssunto
            '.htmlbody = Replace(txtMensagem, vbCrLf, "<br>")
            .htmlbody = strMensagem
            .To = strEmail
            
            .send
        End With
        
        Set Mens = Nothing
        Set Config = Nothing

    Aqui um excelente artigo do site do Avelino, se for do seu interesse, de uma estudada (copiar e colar no navegador) usandoaccess.com.br/tutoriais/enviar-email-usando-o-cdosys.asp?id=1

    Abraço.
    gabrielpn06
    gabrielpn06
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 180
    Registrado : 17/01/2017

    [Resolvido]Emails automáticos Empty Re: [Resolvido]Emails automáticos

    Mensagem  gabrielpn06 2/10/2017, 12:40

    Bom dia, desculpe a demora. Muito obrigado pelas respostas, o exemplo do avelino ajudou bastante!

      Data/hora atual: 27/9/2022, 18:25