[Resolvido]mandar e-mails de 50 a 50 para o Outlook

Olá.
Este é um desafio para avançados em Access, difícil para mim eheheh.
Tenho uma BD  que filtra e manda os e-mails do filtro para o Outlook tudo para o mesmo campo Bcc  .
O Outlook só pode mandar de 50 a 50 e-mails e pretendia fazer isso no código VB da BD.
Alguém ajuda?



Private Sub btn_emails_Click()

'----------------------------------------------
'Criando as variáveis que irão assumir as
'propriedades e métodos das classes do outlook
'----------------------------------------------
Dim OutApp As Object
Dim OutMail As Object
Dim rst As DAO.Recordset
Dim strDestinatarios
Set rst = Me![subformA].Form.RecordsetClone

'----------------------------------------------
'informa se o Outlook está instalado antes de iniciar o processo de envio do email
'----------------------------------------------
If fncOutlookInstalado = False Then
 MsgBox "O Outlook não está instalado...", vbExclamation
 Exit Sub 'Aborta o procedimento
 Else
 If fncOutlookAberto = False Then
'força a abertura do Outlook
   Call Shell("Outlook.exe", vbMinimizedNoFocus)
   'gera uma mensagem para o usuário, que o Outlook está a abrir.
   DoCmd.OpenForm "AVISO"
 End If
End If

'---------------------------------------------
'Carregando a coleção do Outlook
'Similar ao abrir o Outlook
'---------------------------------------------
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

'------------------------------------------------------------
'Abrindo o formulário de email para inserir os itens de email
'Similar ao clicar no botão NOVO do Outlook
'------------------------------------------------------------
Set OutMail = OutApp.CreateItem(0)

'-----------------------------------------------------------------------
'Passando os valores do formulário FILTRAR para os itens de email
'-----------------------------------------------------------------------
Do Until rst.EOF
strDestinatarios = strDestinatarios & rst("EMAIL") & ";"
rst.MoveNext
Loop
On Error Resume Next
strDestinatarios = Left(strDestinatarios, Len(strDestinatarios) - 1)

On Error Resume Next
With OutMail
.To = ""
.BCC = strDestinatarios 'mandar vários mas o destinário ver somente o seu email enviado
.Display

End With

If strDestinatarios = 0 Then
MsgBox ("Não tem e-mail"), vbInformation
End If

'-------------------------------------------------------
'esvaziar a memória do computador usada pelas variáveis objeto.
'-------------------------------------------------------
Set OutMail = Nothing
Set OutApp = Nothing

rst.Close
Set rst = Nothing

End Sub

mas tem que mandar um e-mail separado pra cada um? ou pode mandar pra todos o mesmo e-mail

Mandar pra todos o mesmo e-mail, mensagem.


Tenho uma BD que filtra e manda os endereços dos e-mails do filtro para o Outlook todos no campo Bcc  .
O limite é 50.
O corpo do e-mail, a mensagem está em branco (depois escrevo o conteúdo).
Essa mensagem é igual para, por exemplo, 210 endereços e o limite do Outlook é de 50 endereços de e-mails.

Pus ao filtrar:
Private Sub strFiltra()
....
Dim contaReg As Integer

depois......

If strWhere <> "" Then
strWhere = Left(strWhere, Len(strWhere) - 5) 'Remove os AND extra
Me.subformA.Form.Filter = strWhere
Me.subformA.Form.FilterOn = True
Me.subformA.Requery
contaReg = DCount("[EMAIL]", "Lista")
Me.txtResultado.Value = " " & contaReg
Else
Me.subformA.Form.Filter = ""
Me.subformA.Form.FilterOn = False
Me.subformA.Requery
End If
End Sub


txtResultado é uma caixa de texto no form FILTRAR
assim conta quantos e-mails tem no filtro.
deixo esta BD editada na 1º mensagem, com e-mais mais diversos também para teste
Agora era por condições como se for menor que 50 .... manda ....
se for maior que 50 e menor que 100...
mas se tivesse 2000 e-mails , dava para fazer um ciclo?

fiz este código, pode dar alguma coisa isto? é possível? não consegui o resultado ....
penso que o código faz um ciclo por isso fiz um contador que se igualar a b (nº de envios) pára o envio.
por exemplo 210 emails por 50 em cada envio é 210/50=4,2 envios logo pus int(b)+1 que é = 4+1 envios
'-----------------------------------------------------------------------
'Passando os valores do formulário FILTRAR para os itens de email
'-----------------------------------------------------------------------
a = 0
If Not a = Int(b) + 1 And strDestinatarios <= 50 Then
'Inicia o loop
Do Until rst.EOF
a = a + 1
b = (Me.txtResultado.Value) / 50
strDestinatarios = strDestinatarios & rst("EMAIL") & ";"
rst.MoveNext
'Finaliza o Loop
Loop
On Error Resume Next
strDestinatarios = Left(strDestinatarios, Len(strDestinatarios) - 1)

On Error Resume Next
With OutMail
.To = ""
.BCC = strDestinatarios 'mandar vários mas o destinário ver somente o seu email enviado
.Display
End With
End If

If strDestinatarios = 0 Then
MsgBox ("Não tem e-mail"), vbInformation
End If

'-------------------------------------------------------
'esvaziar a memória do computador usada pelas variáveis objeto.
'-------------------------------------------------------
Set OutMail = Nothing
Set OutApp = Nothing

rst.Close
Set rst = Nothing

End Sub

Não entendi...
No seu sistemas (baixei da primeira mensagem) ele põe apenas a quantidade filtrada
no campo CCO...

O que você pretende?

o Outlook dá-me um limite de mandar 50 endereços de e-mails de uma só vez no campo Cc. ou Bcc.
Por isso só posso mandar em grupos de 50.
Enviar online quero dizer, se enviar mais que isso os destinatários maiores que 50 não recebem....

OK, mas o que você pretende?

editei a minha mensagem anterior , é enviar online em grupos de 50. como posso fazer no código do ACCESS? de tiver por exemplo 210 ou 2000 no form FILTRAR como mandar todos mas em grupos de 50

dá para aplicar um contador como neste exemplos?
http://juliobattisti.com.br/artigos/office/vba_access_p9.asp

Para a dúvida do contador, um novo tópico...

Teste assim:

Código:

Dim iContador As Integer
    '----------------------------------------------
    'Criando as variáveis que irão assumir as
    'propriedades e métodos das classes do outlook
    '----------------------------------------------
    Dim OutApp As Object
    Dim OutMail As Object
    Dim rst As DAO.Recordset
    Dim strDestinatarios
    Set rst = Me![subformA].Form.RecordsetClone

    On Error Resume Next

    '----------------------------------------------
    'informa se o Outlook está instalado antes de iniciar o processo de envio do email
    '----------------------------------------------
    If fncOutlookInstalado = False Then
        MsgBox "O Outlook não está instalado...", vbExclamation
        Exit Sub    'Aborta o procedimento
    Else
        If fncOutlookAberto = False Then
            'força a abertura do Outlook
            Call Shell("Outlook.exe", vbMinimizedNoFocus)
            'gera uma mensagem para o usuário, que o Outlook está a abrir.
            DoCmd.OpenForm "AVISO"
        End If
    End If

    '---------------------------------------------
    'Carregando a coleção do Outlook
    'Similar ao abrir o Outlook
    '---------------------------------------------
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon

    '-----------------------------------------------------------------------
    'Passando os valores do formulário FILTRAR para os itens de email
    '-----------------------------------------------------------------------
    Do Until rst.EOF
        iContador = iContador + 1
        strDestinatarios = strDestinatarios & rst("EMAIL") & ";"

        If iContador = 50 Then
            '------------------------------------------------------------
            'Abrindo o formulário de email para inserir os itens de email
            'Similar ao clicar no botão NOVO do Outlook
            '------------------------------------------------------------

            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .To = ""
                .BCC = strDestinatarios    'mandar vários mas o destinário ver somente o seu email enviado
                .Display
            End With

            strDestinatarios = ""
            iContador = 0
        End If

        If strDestinatarios = 0 Then
            MsgBox ("Não tem e-mail"), vbInformation
        End If

        rst.MoveNext
    Loop

    '-------------------------------------------------------
    'esvaziar a memória do computador usada pelas variáveis objeto.
    '-------------------------------------------------------

    Set OutMail = Nothing
    Set OutApp = Nothing

    rst.Close
    Set rst = Nothing

deu certo mandou 50 endereços de email para o Bcc.
Fiz com ameixa que tem 53, como abrir outra janela do outlook com os restantes?
maçã tem 40 e não manda ...

Está meio corrido pra mim, vamos ver se depois tenho um tempinho a mais para ver isso,
caso outro colega não o faça ou você mesmo encontre a solução.

Boa sorte.

Obrigado a ajuda


dá para fazer outro contador tipo i=i*50 e que se i é diferente de 50 então =j , mandar j endereços de emails

fiz assim mas não dá ...
é preciso utilizar contaReg?

icont = 1  ? antes do end if

Código:

Do Until rst.EOF
        iContador = iContador + 1
        icont = icont * 50
        strDestinatarios = strDestinatarios & rst("EMAIL") & ";"

        If iContador = 50 And Not icont = 50 Then
            '------------------------------------------------------------
            'Abrindo o formulário de email para inserir os itens de email
            'Similar ao clicar no botão NOVO do Outlook
            '------------------------------------------------------------

            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .To = ""
                .BCC = strDestinatarios    'mandar vários mas o destinário ver somente o seu email enviado
                .Display
            End With

            strDestinatarios = ""
            iContador = 0
            icont = 0
        End If

        If strDestinatarios = 0 Then
            MsgBox ("Não tem e-mail"), vbInformation
        End If

        rst.MoveNext
    Loop

Substitui
If contaReg = 0 Then
MsgBox ("Não tem e-mail"), vbInformation
End If

fiz mais isto e está a dar certo:

contaReg = DCount("[EMAIL]", "Lista")
Dim iContador As Integer
  '----------------------------------------------
  'Criando as variáveis que irão assumir as
  'propriedades e métodos das classes do outlook
  '----------------------------------------------
  Dim OutApp As Object
  Dim OutMail As Object
  Dim rst As DAO.Recordset
  Dim strDestinatarios
  Dim q, r, s, t As Integer
'quantidade dos últimos registos menores que 50
q = (contaReg) / 50
r = Int(q)
s = q - r
t = 50 * s 'últimos registos menores que 50

  Set rst = Me![subformA].Form.RecordsetClone

Olá. Tenho a BD  a mandar 50 endereços de e-mail de cada vez.
Se todos os contactos tiverem e-mail o processo corre bem, mas se nem todos têm, manda e-mail contando com os que estão nulos como se pode ver no exemplo do filtro ananás chile.
Como corrigir?
Obrigado

Olá Alpedro,

Não trabalho com este tipo de código, mas fiz uma pesquisa na internet e descobri este link que talvez possa ajudá-lo. Quem sabe se tudo não é uma questão de configurar o Outlook?

http://www.pcworld.com/article/2859285/this-is-not-spam-how-to-create-bulk-emails-in-microsoft-outlook-2013.html


Outros links:

http://www.jephens.com/2007/05/13/how-to-send-e-mail-from-ms-access-using-outlook/

http://windowssecrets.com/forums/showthread.php/124709-Email-Merge-from-Access

FAQ:

https://www.fmsinc.com/microsoftaccess/Email/faq.htm

Obrigado.

É tipo:

Do While Not rst.EOF And contaReg > 49 And EMAIL = Not Null


mas este não dá

ERRADO:

Do While Not rst.EOF And contaReg > 49 And EMAIL = Not Null

CERTO:

Do While Not rst.EOF And contaReg > 49 And Not IsNull(EMAIL) Or EMAIL <> ""

testando

O contador conta o email campo vazio
aqui:
Do While Not rst.EOF And contaReg > 49 And Not IsNull(EMAIL)

tenho que ir buscar EMAIL á consulta "Lista" e atribuir nulo?

Tente assim:
Veja vc tem que desfazer o laço caso se o campo EMAIL estiver nulo, com Exit Do. Somente cumprida a condição com o campo EMAIL preenchido o laço Do While seguirá.

Código:


Do While Not rst.EOF
  If Not IsNull(rs.Fields("EMAIL")) Then
    If contaReg > 49  Then
     .....
    Else
    Exit Do
    End If
  Else
  Exit Do
  End If
Loop

O código é este:

Do While Not rst.EOF And contaReg > 49
       iContador = iContador + 1
       strDestinatarios = strDestinatarios & rst("EMAIL") & ";"
 
       
       If iContador = 50 Then
           '------------------------------------------------------------
           'Abrindo o formulário de email para inserir os itens de email
           'Similar ao clicar no botão NOVO do Outlook
           '------------------------------------------------------------

           Set OutMail = OutApp.CreateItem(0)

           With OutMail
               .To = ""
               .BCC = strDestinatarios    'mandar vários mas o destinário ver somente o seu email enviado
               .Display
           End With

           strDestinatarios = ""
           iContador = 0
       End If
       
       rst.MoveNext
   Loop

faço como?

pode ver na BD em anexo?

Alpedro,

Não trabalho com este tipo de código só estou fazendo algumas correções de posicionamento que considero pertinentes porque é assim que funciona comigo em alguns aplicativos.

Código:


rs.MoveFirst
Do While Not rst.EOF And contaReg > 49
       iContador = iContador + 1
       strDestinatarios = strDestinatarios & rst("EMAIL") & ";"
 
      
       If iContador = 50 Then
           '------------------------------------------------------------
           'Abrindo o formulário de email para inserir os itens de email
           'Similar ao clicar no botão NOVO do Outlook
           '------------------------------------------------------------

           Set OutMail = OutApp.CreateItem(0)

           With OutMail
               .To = ""
               .BCC = strDestinatarios    'mandar vários mas o destinário ver somente o seu email enviado
               .Display
           End With

           strDestinatarios = ""
           iContador = 0
       End If
     Loop  
    rst.MoveNext
  

tentei assim nada :
If EMAIL = Not Null Then
iContador = iContador + 1
End If

repetiu o 1º e-mail várias vezes, só isso

eheheh

vamos ver se alguém tem outra ideia, obrigado pela ajuda

não dá assim pq?

      If Not rst("EMAIL") <> "" Then
      If iContador = 50 Then
          '------------------------------------------------------------
          'Abrindo o formulário de email para inserir os itens de email
          'Similar ao clicar no botão NOVO do Outlook
          '------------------------------------------------------------

          Set OutMail = OutApp.CreateItem(0)

          With OutMail
              .To = ""
              .BCC = strDestinatarios    'mandar vários mas o destinário ver somente o seu email enviado
              .Display
          End With

          strDestinatarios = ""
          iContador = 0
      End If
      End If

ou

If Not rst("EMAIL") <> "" Then
iContador = iContador + 1
End If

assim também não dá:

       If IsNull(strDestinatarios) Then
               rst.MoveNext
       End If
ou
If Not IsNull(rst!EMAIL) Then
strDestinatarios = strDestinatarios & rst("EMAIL") & ";"
End If

deu certo !!!!

If Not rst.Fields("EMAIL").Value = "Null" Then
iContador = iContador + 1
End If

Olá Alpedro,

Será que realmente deu certo com o Null entre aspas ("Null")? Verifique !!! O certo é sem as aspas. Como é uma palavra reservada do Access fica em azul na hora.

só dá com "Null", ou seja campo vazio.
Obrigado.

Olá Alpedro,

"Null" = ""

Tente com "" ou vbNullString se dá certo também !!!

"Null" não fica a azul


deu certo sim
Obrigado