Início
![[Resolvido]VBA para enviar mensagens de WhatsApp de 30 em 30 telefones Empty](https://2img.net/i/empty.gif)
Belobo 3/4/2021, 03:50Boa noite
Trago um codigo que envia mensagens via whatsapp
Todo o codigo foi realizado com busca aqui e ajuda dos desenvolvedores
Agora preciso dar uma melhorada
Fazer com que ele faca a execucao do codigo de 30 em 30 telefones da tabela
Apos rodar essa rotina o VBA precisa alem disso fazer com seja criada uma tabela com nomenclatura DDMMAA HHMMSS para guardar os ultimos numeros enviados como garantia de controle e que sejam excluidos da tabela original
Segue codigo que ja funciona , mas o problema é que com uma base grande nao conseguimos enviar as mensagens pois os navegadores abrindo serao muitos
por isso de 30 em 30 para poder executar e partir aos poucos nao travando maquina nem banindo sua conta de whatsapp
Observacao importante as autorizacoes dos clientes devem existir para nao ferir qualquer Lei de protecao ao consumidor
Codigo original
Dim db As DAO.Database 'Variável do banco de dados
Dim rs As DAO.Recordset
Set db = CurrentDb 'Banco de Dados Atual
Set rs = db.OpenRecordset("TblCliente") 'Abre no banco de dados a tabela
Do While Not rs.EOF ' Enquanto não chegar no final dos registros faz o loop
Application.FollowHyperlink "https://api.whatsapp.com/send?phone=" & "+55" & rs.Fields("Whatapps") & "&text=" & "Olá " & Mid(rs.Fields("Nome"), 1, InStr(1, rs.Fields("Nome"), " ") - 1) & " !! " & "Aqui é a Renata da Loja xyz. Faço parte do marketing da AD. Estamos num momento muito difícil do país. Cuide-se seguindo todos os protocolos de segurança. Precisando de atendimento via WhatsApp , além de meu número , temos 2 colaboradoras no plantão : Larissa e Milena. Compre com segurança. Levamos até sua casa e também fazemos entrega pelo correio !"
rs.MoveNext 'Move para o próximo registro
Loop
'Call SendKeys("{TAB}", True)
'C'all SendKeys("{ENTER}", True) ' removido um tab, o enter responder melhor.
'Call SendKeys("{ENTER}", True)
'Fecha as conexão
Set rs = Nothing
Set db = Nothing
End Sub
Trago um codigo que envia mensagens via whatsapp
Todo o codigo foi realizado com busca aqui e ajuda dos desenvolvedores
Agora preciso dar uma melhorada
Fazer com que ele faca a execucao do codigo de 30 em 30 telefones da tabela
Apos rodar essa rotina o VBA precisa alem disso fazer com seja criada uma tabela com nomenclatura DDMMAA HHMMSS para guardar os ultimos numeros enviados como garantia de controle e que sejam excluidos da tabela original
Segue codigo que ja funciona , mas o problema é que com uma base grande nao conseguimos enviar as mensagens pois os navegadores abrindo serao muitos
por isso de 30 em 30 para poder executar e partir aos poucos nao travando maquina nem banindo sua conta de whatsapp
Observacao importante as autorizacoes dos clientes devem existir para nao ferir qualquer Lei de protecao ao consumidor
Codigo original
Dim db As DAO.Database 'Variável do banco de dados
Dim rs As DAO.Recordset
Set db = CurrentDb 'Banco de Dados Atual
Set rs = db.OpenRecordset("TblCliente") 'Abre no banco de dados a tabela
Do While Not rs.EOF ' Enquanto não chegar no final dos registros faz o loop
Application.FollowHyperlink "https://api.whatsapp.com/send?phone=" & "+55" & rs.Fields("Whatapps") & "&text=" & "Olá " & Mid(rs.Fields("Nome"), 1, InStr(1, rs.Fields("Nome"), " ") - 1) & " !! " & "Aqui é a Renata da Loja xyz. Faço parte do marketing da AD. Estamos num momento muito difícil do país. Cuide-se seguindo todos os protocolos de segurança. Precisando de atendimento via WhatsApp , além de meu número , temos 2 colaboradoras no plantão : Larissa e Milena. Compre com segurança. Levamos até sua casa e também fazemos entrega pelo correio !"
rs.MoveNext 'Move para o próximo registro
Loop
'Call SendKeys("{TAB}", True)
'C'all SendKeys("{ENTER}", True) ' removido um tab, o enter responder melhor.
'Call SendKeys("{ENTER}", True)
'Fecha as conexão
Set rs = Nothing
Set db = Nothing
End Sub