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


2 participantes

    [Resolvido]Emvio de email em massa sem outlook

    Finformática
    Finformática
    VIP
    VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1098
    Registrado : 23/03/2010

    [Resolvido]Emvio de email em massa sem outlook Empty [Resolvido]Emvio de email em massa sem outlook

    Mensagem  Finformática 12/5/2015, 12:50

    Caros Amigos,

    Adaptei o código (retirado aqui do forum) abaixo para enviar emails em massa. Em outras palavras, filtro os aniversariantes de determinado intervalo de datas e desejo enviar mensagens para todos. O que ocorre é que só envia para o primeiro da relação. Onde está o erro desta rotina? Não consigo entender. Juntei um código que envia em massa com outlook com outro que envia sem outlook para um único email. Ajudem-me.

    Grande abraço

    Sub EnviarEmailCDOSolicitante()
    Dim oMensagem As Object
    Dim oConfiguração As Object
    Dim sCorpo As String
    Dim vFields As Variant
    Dim sDestinatário As String
    Dim sCc As String
    Dim sCco As String
    Dim sMsgTempo As String
    Dim strLocal As String

    ' ---------------------------------------------

    Set Rst = CurrentDb.OpenRecordset("TbEmail AUX")

    Do Until Rst.EOF

    em1 = Rst.Fields("Email")
    ''em2 = rst.Fields("E_mail_2")

    If Not IsNull(em1) Then
       strDestinatarios = strDestinatarios & Rst("EMail") & ";"
    End If

    ''If Not IsNull(em2) Then
     '  'strDestinatarios = strDestinatarios & rst("E_Mail_2") & ";"
    ''End If

    Rst.MoveNext

    Loop

    ''strDestinatarios = Left(strDestinatarios, Len(strDestinatarios) - 1)

    '----------------------------------------------------------------




    ' ---------------------------------------------




    sDestinatário = strDestinatarios
    'sDestinatário = Email
    'sCc = ""
    'sCco = ""
    'If Not IsNull([arquivo]) Then
    'strLocal = arquivo
    'Else
    'End If

    'If MsgBox("Enviar e-mail para o destinatário " & Destinatário & vbNewLine & _
    '"através do e-mail " & sDestinatário, vbYesNo + vbQuestion, "  InfoBasic Smart System") = vbYes Then

    'If IsNull(sDestinatário) Then
    'MsgBox "Não há endereço de e-mail" & Chr(10) & _
    '"cadastrado para o destinatário " & Destinatário & "!", vbOKOnly + vbInformation
    'Exit Sub
    'End If

    'If IsNull(Email) Then
    'MsgBox "O e-mail não pode ser enviado!" & Chr(10) & _
    '"Verifique a existência do endereço.", vbOKOnly + vbCritical
    'Exit Sub
    'End If

    'If IsNull(Assunto) Then
    'MsgBox "O e-mail não pode ser enviado!" & Chr(10) & _
    '"Informe o Assunto deste encaminhamento.", vbOKOnly + vbCritical
    'Me.Assunto.SetFocus
    'DoCmd.CancelEvent
    'Exit Sub
    'End If

    Assunto = "Parabéns pelo seu aniversário..."

    'If Me.Texto = "" Then
    'MsgBox "O e-mail não pode ser enviado!" & Chr(10) & _
    '"O campo Mensagem encontra-se em branco.", vbOKOnly + vbCritical
    'Me.Texto.SetFocus
    'DoCmd.CancelEvent
    'Exit Sub
    Texto = "Confesso que hoje não consigo expressar toda minha alegria, simplesmente pelo fato de saber que nesta data tão maravilhosa você está muito mais feliz. Que Deus ilumine todos os dias da sua vida, abençoando seu aniversário!"
    Texto1 = "São os mais sinceros desejos do seu amigo MARCOS MENEZES. Grande abraço"


    'Else

    'DoCmd.OpenForm "frmProgresso"
    'Forms!frmProgresso!lblInfo.Caption = "Enviando dados..." & vbCrLf & "Esse processo pode levar vários minutos dependendo o tamanho dos arquivos enviados e da velocidade da Internet." & vbCrLf & vbCrLf & "Por favor, aguarde..."


    Set oMensagem = CreateObject("CDO.Message")
    Set oConfiguração = CreateObject("CDO.Configuration")

    oConfiguração.Load -1 'Padrões CDO
    Set vFields = oConfiguração.Fields
    With vFields
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" 'pode ser usado outro smtpserver
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 ' existem outros smtpserverport. verifique na internet
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    'Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    '.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "petrus.empresarial@gmail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "marcosmenezesmulti@gmail.com"
    '.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Petrusge2000"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Daniel2015"
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

    .Update
    End With

    If Format(Now, "hh:mm:ss") >= "00:00:01" And Format(Now, "hh:mm:ss") < "12:00:00" Then
    sMsgTempo = "bom dia"
    ElseIf Format(Now, "hh:mm:ss") >= "12:01:00" And Format(Now, "hh:mm:ss") < "18:00:00" Then
    sMsgTempo = "boa tarde"
    ElseIf Format(Now, "hh:mm:ss") >= "18:01:00" And Now = Format(Now, "hh:mm:ss") < "23:59:59" Then
    sMsgTempo = "boa noite"
    End If


    sCorpo = "Prezado(a) Senhor(a), " & [sMsgTempo] & vbNewLine & vbNewLine & Texto & vbNewLine & vbNewLine & Texto1
    '& vbNewLine & _
    'vbNewLine & _
    'vbNewLine & _
    'DLookup("[RSocial]", "tblEmpresa") & vbNewLine & _
    '"Endereço: " & [txtEnder] & vbNewLine & _
    '"Fale conosco: Tel/Fax " & [txtComunicação] & vbNewLine

    With oMensagem
    Set .Configuration = oConfiguração
    .To = Me.Email 'mude aqui para alterar o destinatário
    'If IsNull([CC]) Then
    '.CC = ""
    'Else
    '.CC = Me.CC 'com cópia
    'End If
    'If IsNull([Cco]) Then
    '.BCC = ""
    'Else
    '.BCC = Me.Cco 'com cópia oculta
    'End If
    .From = "marcosmenezesmulti@gmail.com" 'mude para o seu e-mail
    .Subject = "" & Assunto ' mude para o assunto que desejar
    .TextBody = sCorpo
    'If Not IsNull([arquivo]) Then
    '.AddAttachment strLocal
    'Else: End If
    .Send
    End With
    'DoCmd.Close acForm, "frmProgresso"
    MsgBox "E-mail enviado com sucesso.   ", vbInformation, "  Parabéns aniversariantes"
    'End If
    Exit Sub

    End Sub
    Finformática
    Finformática
    VIP
    VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1098
    Registrado : 23/03/2010

    [Resolvido]Emvio de email em massa sem outlook Empty Re: [Resolvido]Emvio de email em massa sem outlook

    Mensagem  Finformática 12/5/2015, 14:35

    Caros amigos,

    Sei que não tiveram o tempo suficiente para analisar o código, porém consegui descobrir. Era apenas troca de noves de variáveis. Tudo OK. Contudo, muito obrigado a todos.

    Grande abraço
    wsenna
    wsenna
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 491
    Registrado : 22/12/2009

    [Resolvido]Emvio de email em massa sem outlook Empty Re: [Resolvido]Emvio de email em massa sem outlook

    Mensagem  wsenna 20/5/2015, 07:03

    Olá Kinhosinfo, bom dia.

    Amigão, fui eu quem disponibilizou o programa do qual você diz ter tirado o código da Petrus Empresarial.
    Gostaria de, se possível, que você disponibilizasse o seu aplicativo para que possamos estudar o seu código.
    Obs: meu Access ainda é o velho e bom 2003.

    Abraços, WSenna
    Finformática
    Finformática
    VIP
    VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1098
    Registrado : 23/03/2010

    [Resolvido]Emvio de email em massa sem outlook Empty Re: [Resolvido]Emvio de email em massa sem outlook

    Mensagem  Finformática 21/5/2015, 01:27

    Grande WSenna,

    Muito grato pelo seu interesse com este meu problema. Sua intenção com seu código era enviar emails só para um destinatário, como demonstra no formulário, ou pode adaptar para envios em massa? Fiz diversas alterações, conforme código acima, porém só enviava para um destinatário. Depois de batalhar muito notei que havia trocado os nomes de variáveis. Consertei e acho que resolveu. Veja linhas abaixo:

    .To = Me.Email 'mude aqui para alterar o destinatário ----------- Para meu código alterado a variável está errada.

    .To = sDestinatário ------------- Esta seria a minha variável correta.

    Seria isso mesmo para envios em massa?

    Muito grato

    Grande abraço.

    Conteúdo patrocinado


    [Resolvido]Emvio de email em massa sem outlook Empty Re: [Resolvido]Emvio de email em massa sem outlook

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 21/11/2024, 12:15