Excel Enviar mensagem para o whatsapp via Excel

josequali · 7 de agosto de 2020

@LaerteB

Atualmente adaptei um comando para enviar mensagem de e-mail no outlook pelo excel utilizando a mensagem da combobox1 para para um e-mail especifico e consegui. Queria tentar fazer o mesmo processo, só que com whatsapp. Comecei, mas me perdi nos códigos.

O objetivo é enviar a mensagem, mas não para um contato especifico e sim para um grupo do whatsapp na empresa em que trabalho (qualidade), para que possam receber uma notificação quando um novo processo for aberto. No caso o comando deve fazer um loop para achar o nome do grupo do whatsapp especificado.

A mensagem enviada deve ser a seguinte.

"Prezados, uma nova solicitação de análise de soja do" & combobox1 & " foi solicitada em nosso sistema. Por favor, verificar!"

Ou seja a mensagem da combobox deve ficar entre essa mensagem padrão, assim como faço na do e-mail (que esta em anexo no modelo do userform que estou encaminhando). Poderia me ajudar? Desde já agradeço. Muito obrigado!

whatsapp.zip

LaerteB · 7 de agosto de 2020

Boa tarde, josequali

Vou ser sincero contigo, não uso WhatsApp Web (somente uso o WhatsApp normal pelo celular), e o envio de

mensagens pode ser barrado pelo próprio WhatsApp se achar que é um "Bot" (fique atento a isso)...

Teria que analisar com muito mais detalhes (por não ter feito isso ainda)... achei melhor passar um Link

que pode te ajudar neste sentido e estou colando também os códigos que foram tirados desse Link,

que se encontram abaixo:

https://pt.stackoverflow.com/questions/253281/vba-whatsapp-web

Sub Botão6_Clique()
'Declaração das variáveis
Dim contato As String
Dim retorno As String
Dim concluido As String
Dim veiculo As String
Dim cadastro As String
Dim transferencia As String
Dim substituicao As String
Dim desalienacao As String
Dim html As String

veiculo = Sheets(1).veiculo
cadastro = Sheets(1).cadastro
transferencia = Sheets(1).transferencia
substituicao = Sheets(1).substituicao
desalienacao = Sheets(1).desalienacao

'atribui a variável linha o número 2, para iniciar na segunda linha da primeira coluna
linha = 2

'Chama o navegador e abre no link setado
ActiveWorkbook.FollowHyperlink "https://web.whatsapp.com/"

'Vai percorrer toda lista de contatos, até que ela encerre
Do Until Sheets(1).Cells(linha, 2) = ""

    'Chama função de espera por 2 segundos
    Fazer (15000)
    contato = Cells(linha, 2)

    'Se não tiver nenhum contato, aparece msg box e solicita a inclusão de algum
    If contato = "" Then
        MsgBox "Preencha os contatos"
        Exit Sub
    End If
    retorno = Cells(linha, 4)
    concluido = Cells(linha, 5)

    'RETORNO VEÍCULO
    If retorno = "Veículo" And concluido <> "ok" Then

        'Chama a função de espera por 3 segundos
        Fazer (15000)

        'Aperta as teclas do teclado
        Call SendKeys("{TAB}", True)
        Call SendKeys("{BS 1000}", True)
        Call SendKeys(contato, True)
        Call SendKeys("~", True)

        'Chama a função de espera por 8 segundos e envia a mensagem
        Fazer (15000)
        Call SendKeys(veiculo, True)
        Call SendKeys("~", True)
        Call SendKeys("{TAB}", True)

    'RETORNO CADASTRO
    ElseIf retorno = "Cadastro" And concluido <> "ok" Then

        'Chama a função de espera por 3 segundos
        Fazer (15000)

        'Aperta as teclas do teclado
        Call SendKeys("{TAB}", True)
        Call SendKeys("{BS 1000}", True)
        Call SendKeys(contato, True)
        Call SendKeys("~", True)

        'Chama a função de espera por 8 segundos e envia a mensagem
        Fazer (15000)
        Call SendKeys(cadastro, True)
        Call SendKeys("~", True)
        Call SendKeys("{TAB}", True)

    'RETORNO TRANSFERÊNCIA
    ElseIf retorno = "Transferência" And concluido <> "ok" Then

        'Chama a função de espera por 3 segundos
        Fazer (15000)

        'Aperta as teclas do teclado
        Call SendKeys("{TAB}", True)
        Call SendKeys("{BS 1000}", True)
        Call SendKeys(contato, True)
        Call SendKeys("~", True)

        'Chama a função de espera por 8 segundos e envia a mensagem
        Fazer (15000)
        Call SendKeys(transferencia, True)
        Call SendKeys("~", True)
        Call SendKeys("{TAB}", True)

    'RETORNO SUBSTITUIÇÃO
    ElseIf retorno = "Substituição" And concluido <> "ok" Then

        'Chama a função de espera por 3 segundos
        Fazer (15000)

        'Aperta as teclas do teclado
        Call SendKeys("{TAB}", True)
        Call SendKeys("{BS 1000}", True)
        Call SendKeys(contato, True)
        Call SendKeys("~", True)

        'Chama a função de espera por 8 segundos e envia a mensagem
        Fazer (15000)
        Call SendKeys(substituicao, True)
        Call SendKeys("~", True)
        Call SendKeys("{TAB}", True)

    'RETORNO DESALIENAÇÃO
    ElseIf retorno = "Desalienação" And concluido <> "ok" Then

        'Chama a função de espera por 3 segundos
        Fazer (15000)

        'Aperta as teclas do teclado
        Call SendKeys("{TAB}", True)
        Call SendKeys("{BS 1000}", True)
        Call SendKeys(contato, True)
        Call SendKeys("~", True)

        'Chama a função de espera por 8 segundos e envia a mensagem
        Fazer (15000)
        Call SendKeys(desalienacao, True)
        Call SendKeys("~", True)
        Call SendKeys("{TAB}", True)
    End If
    linha = linha + 1
Loop

End Sub

Function Fazer(ByVal Acao As Double)
    Application.Wait (Now() + Acao / 24 / 60 / 60 / 1000)

End Function

Espero que isso te ajude de alguma maneira a criar o que está querendo ..

Qualquer dúvida poste novamente

Aguardando sua resposta e seu Feed Back ... se foi útil, não esqueça de clicar na "mãozinha"

LaerteB

josequali · 7 de agosto de 2020

@LaerteB Fiquei perdido, porque não entendi como montar o painel de acordo com as informações de quem confeccionou a macro. Dei uma olhada também no site, mas ele não explicou muito. O objetivo no meu caso é enviar mensagens única notificação a cada nova solicitação interna aberta, não é mensagem em massa para contatos aleatórios, que nesse caso acredito que poderia dar problema e ser reconhecido como "Bot", meu objetivo é enviar apenas para um grupo especifico no meu trabalho e não para vários contatos. Tentei algumas macros de outros usuários, mas não funcionou porque os modelos que acho é para enviar para vários contatos ao mesmo tempo e não quero isso. . Quero fazer naquele modelo que te enviei acima, algo mais simples, direcionado e prático. , só preciso saber como fazer, rs.

LaerteB · 8 de agosto de 2020

Bom dia, josequali

Amigo, já está feito os códigos que pediu referente as mensagens acima ... no anexo o arquivo exemplo
que fará o envio da mensagem ao WhatsApp conforme o Tipo de Ervilha que se encontra no
combobox1...

Criei na Sheet(bancodedados) as colunas "G"(Contatos) e "H"(Mensagem); nos contatos deixei
como "Empresa Qualidade" (somente como um exemplo... altere para o nome correto que se
encontra no seu WhatsApp) e a célula "H2" fica vazia até que tu escolha um tipo de ervilha
no Combobox1 (dependendo do Tipo a mensagem é inserida na planilha, dentro da célula "H2" -
igual a mensagem que você tinha escrito aqui no Tópico) ...

Eu testei até a mensagem ser inserida na "H2", não testando o envio para o WhatsApp, pois
como lhe falei não utilizo este tipo de serviço no PC, somente no celular ... desta forma
faça um teste com um amigo ou outra pessoa, para ver se está enviando corretamente (alterando
a Célula "G2" para o contato teste)...

OBS: Pode alterar o tempo (TimeValue) de cada etapa do envio; uma sugestão deixe o WhatsApp Web
aberto antes de enviar qualquer mensagem, para facilitar o envio e não precisar colocar mais tempo ...

OBS2: Insira o trecho abaixo, depois do Loop OK:

Range("H2").clear

Espero que seja isso que queria..

Qualquer coisa estamos aqui para ajudar ...

Aguardando sua resposta e seu Feed Back ... se foi útil, não esqueça de clicar na "mãozinha"

LaerteB

whatsapp Solucao 1 - LB - 08-08-2020.zip

josequali · 9 de agosto de 2020

@LaerteB Boa noite! Muito obrigado! vou testar e te dou um retorno .

josequali · 10 de agosto de 2020

@LaerteB Bom dia! Então tentei, mas não funcionou. Até adicionei o código para executar o explore e o explore e abrir o whatsapp (o outro não funcionava - veja abaixo). Mesmo assim ele não realiza a pesquisa.

Estava assim não executava o comando.

Shell "C:\Program Files\Google\Chrome\Application\chrome.exe" & " https://web.whatsapp.com/"

Deixei assim:

ActiveWorkbook.FollowHyperlink Address:=" https://web.whatsapp.com/"

Mas ele não realiza a busca do contato e nem envia a mensagem.

whatsapp Solucao 1 - LB - 08-08-2020.zip

LaerteB · 10 de agosto de 2020

Bom dia, josequali

Eu verifiquei e descobri que não tinha colocado a sheet corretamente (deve ter sido o

cansaço rsrsrs ), então corrigi para o correto; abaixo a imagem com a correção e

as explicações adicionais (como mencionei na mensagem anterior não utilizo

este aplicativo no PC, desta forma por gentileza fazer o teste); eu também verifiquei que seria melhor
tu trocar o código abaixo:

  If Cells(linha, 8) = "" Then
   MsgBox "Escolha ao menos 1 Tipo de Ervilha!", vbInformation, "Atenção!"
   ComboBox1.SetFocus
   Exit Sub
  End If

por esse abaixo:

  If ComboBox1.Text = "" Then
   MsgBox "Escolha ao menos 1 Tipo de Ervilha!", vbInformation, "Atenção!"
   ComboBox1.SetFocus
   Exit Sub
  End If

Verifique e teste antes, espero que agora funcione corretamente..

Qualquer dúvida pode postar...

Aguardando sua resposta e seu Feed Back ... se foi útil, não esqueça de clicar na "mãozinha"

LaerteB

josequali · 11 de agosto de 2020

@LaerteB @LaerteB Boa noite! Muito obrigado! Realizei as mudanças indicadas, mas ainda continua dando erro no código, tentei mudar como descrito na imagem, mas ainda sim não deu certo.

whatsapp envio de mensagem.zip

LaerteB · 12 de agosto de 2020

Boa noite, josequali

Verifique novamente a imagem que lhe enviei na mensagem acima da sua última...

o erro está ocorrendo por falta das aspas - o correto é Sheets("bancodedados") e não Sheets(bancodedados) como tu inseriu na imagem acima; não se preocupe isso pode acontecer para qualquer um ..

Verifique e teste novamente, agora vai funcionar ..

Aguardando sua resposta e seu Feed Back ... se foi útil, não esqueça de clicar na "mãozinha"

LaerteB

josequali · 13 de agosto de 2020

@LaerteB Boa noite! Realizei a mudança sinalizada e o código não da mais erro, no entanto, quando abre o whatsapp ele não da o comando para realizar a pesquisa e enviar a mensagem .

LaerteB · 13 de agosto de 2020

Boa tarde, josequali

Então verifiquei e percebi que não tinha colocado uma linha em um trecho de código, sem essa

linha ele não colocava na coluna "G2" da Sheets "bancodedados" a mensagem do Tipo...

Abaixo está a correção, é só você substituir o que tinha antes por esse:

Private Sub ComboBox1_Change()

Sheets("bancodedados").Select

 If ComboBox1.Text = "Tipo1" Then
   Range("H2").Value = "Uma nova solicitação de ervilha do Tipo1 foi solicitada, verificar o sistema."
   
  ElseIf ComboBox1.Text = "Tipo2" Then
   Range("H2").Value = "Uma nova solicitação de ervilha do Tipo2 foi solicitada, verificar o sistema."

   ElseIf ComboBox1.Text = "Tipo3" Then
   Range("H2").Value = "Uma nova solicitação de ervilha do Tipo3 foi solicitada, verificar o sistema."
 
 End If

End Sub

Verifique se isto ajuda na solução do seu problema...

Se ainda houver qualquer problema informe aqui novamente, espero que desta vez não precise .

Aguardando sua resposta e seu Feed Back ... se foi útil, não esqueça de clicar na "mãozinha"

LaerteB

josequali · 21 de agosto de 2020

@LaerteB Boa noite! Desculpe pela demora, estava sem celular para fazer o teste. Fiz mudanças indicadas, mas não deu certo. Durante o comando ele joga na aba de pesquisa do contato a mensagem programada (veja a foto).

Realizei um teste, mudei em contato para linha 7 e ele dessa vez encontrou o contato, mas não colou a mensagem (vide imagem 2).

Nó código foi essa mudança que foi feita em Private Sub btnenviar_Click():

contato = Cells(linha, 7)
texto = Cells(linha, 8)

por

contato = Cells(linha, 7)
texto = Cells(linha, 7)

LaerteB · 21 de agosto de 2020

Boa tarde, josequali

Altere como informo abaixo:

No:

Private Sub btnenviar_Click()

Altere os dois comandos que aparecem, como:

  Call SendKeys("{ENTER}", True)

Para:

  Call SendKeys("~", True)

Por gentileza deixe como coluna "8" no "texto", não altere como mencionou na mensagem acima...

Outra coisa se quiser aumentar para mais alguns segundos (tipo de 04 para 06 ou 08), se achar

que é pouco tempo:

 Application.Wait (Now + TimeValue("00:00:04"))

Por gentileza verificar e ver se agora funciona de acordo..

Aguardando sua resposta e seu Feed Back ... se foi útil, não esqueça de clicar na "mãozinha"

LaerteB

josequali · 21 de agosto de 2020

@LaerteB Boa tarde! Então ,fiz as alterações indicadas, mas ele continua lançado a informação do texto na caixa de contato

josequali · 22 de agosto de 2020

@LaerteB

whatsapp envio de mensagem.zip

LaerteB · 23 de agosto de 2020

Bom dia, josequali

Amigo, agora consegui resolver este seu "problema"; testei em minha máquina virtual e

com algumas alterações foi enviado com sucesso ..

Agora vamos as informações e o código com suas alterações; primeiro eu testei com

meu Browser principal (no meu caso é o Firefox, e não tem problema se o seu é o Chrome

da no mesmo), não precisa estar aberto o Browser;

2º Quando clicar no botão "Whatsapp" do seu "form" ele abrirá o seu Browser e logo

em seguida a URL do "web.whatsapp", mas tu terás que inserir o código QR dele

(antes disso saia de todos os "web.whatsapp" primeiro, clicando no celular "web.whatsapp"

e depois em sair de todos);

Quando abrir o WhatsApp no Browser, o programa irá executar todo o seu processo e

enviar a mensagem para o contato ..

Abaixo o trecho do código com suas alterações que estão funcionando:

Private Sub btnenviar_Click()

' Shell "C:\Program Files\Google\Chrome\Application\chrome.exe" & " https://web.whatsapp.com/"
 ActiveWorkbook.FollowHyperlink Address:=" https://web.whatsapp.com/"

 Application.Wait (Now + TimeValue("00:00:08"))

 Do Until Sheets("bancodedados").Cells(linha, 7) = ""

 Application.Wait (Now + TimeValue("00:00:04"))

 
 
 texto = Cells(linha, 8)
 contato = Cells(linha, 7)
 

 Application.Wait (Now + TimeValue("00:00:04"))

  Call SendKeys("{TAB}", True)
  
 Application.Wait (Now + TimeValue("00:00:01")) 'acrescentado esta linha

  Call SendKeys(contato, True)
  
 Application.Wait (Now + TimeValue("00:00:01")) 'acrescentado esta linha

  Call SendKeys("~", True) 'entra na tela do contato no WhatsApp

 Application.Wait (Now + TimeValue("00:00:04"))

  Call SendKeys(texto, True)
  
 Application.Wait (Now + TimeValue("00:00:01")) 'acrescentado esta linha

  Call SendKeys("~", True)

 linha = linha + 1

 Loop

Estou também anexando o arquivo exemplo com todas as alterações para que tu

faça o teste e verifique se era isso teria que fazer .

Aguardando sua resposta e seu Feed Back ... se foi útil, não esqueça de clicar na "mãozinha"

LaerteB

whatsapp envio de mensagem solucao 2 LB - 23-08-20.zip

josequali · 23 de agosto de 2020

@LaerteB Funcionou perfeitamente! só tive que ajustar o tempo de execução, porque minha internet não ajuda muito, rs. Cara Muito obrigado! Que Deus te abençoe meu filho. Perfeito!

Putzkadu · 19 de outubro de 2020

Boa tarde! Será que vocês poderiam me enviar na versão final? Estou tentando para fazer o envio de mensagem para clientes da construtora que trabalho, mas ele digita o texto na pesquisa e não pesquisa o contato. Estou ficando maluco kkkkk

LaerteB · 19 de outubro de 2020

Boa tarde, @Putzkadu

Amigo eu deixei o arquivo exemplo com o código que funciona no

post #16 (o arquivo é "whatsapp envio de mensagem solucao 2 LB - 23-08-20.zip")

uma parte do post #16 para tu se situar:

Em 23/08/2020 às 10:47, LaerteB disse:

Bom dia, josequali

Amigo, agora consegui resolver este seu "problema"; testei em minha máquina virtual e ....

Baixe e verifique....

Qualquer coisa estamos aqui para ajudar...

Aguardando sua resposta e seu Feed Back ... não esqueça de clicar na "mãozinha"

LaerteB

Juliano Leite · 20 de janeiro de 2021

@LaerteB, bom dia

Se possível, gostaria muito de seu auxílio!

Baixei o arquivo do post#16 e ele é perfeito, entretanto eu precisava encaminhar msgs para uma lista de contatos.

Tentei fazer com o arquivo exemplo, porém ele busca apenas o primeiro contato e faz o envio da msg, quando vai para o segundo contato ele não faz a busca do contato no watts, mas sim envia para o primeiro contato o nome do segundo contato como msg.

A msg que preciso envia será a mesma, porém preciso que corra a lista de contato e faça o envio para todos (o máximo de contato que vou ter é de 48).

Para você entender melhor, trabalho em uma empresa de transporte de passageiros e gostaria de adicionar como contato os passageiros de determinada linha (fretamento de fábrica), assim quando houver qualquer tipo de atraso nessa linha estaria informando o usuário. É verdade que fazer um grupo para o envio seria mais fácil, porém temos muitos casos em que o usuário por necessidade da empresa que trabalha troca de turno constantemente, sendo assim o envio por msg individual seria mais interessante. Sem falar nos inúmeros casos em que a empresa solicita para uma quantidade pequena de colaboradores que iniciem a jornada mais cedo. Então nossa empresa atua com o serviço que chamamos de taxi (serviço que não é necessário ônibus ou micro, devido a quantidade de usuários). Em situações como essa, poderia encaminhar msg para essa lista de contato informando que horas a linha vai iniciar; ponto de embarque; ou atraso (caso ocorra).

O mesmo posso fazer com o motorista, notificando modificações no itinerário (pois posso ter de 3 a 6 motorista atendendo a mesma linha).

Joselito Dionisio Mendonca · 24 de maio de 2021

Gostaria de ajuda para ao invés de enviar o texto enviar um gráfico, copiando os calores das células A1:X77 e enviar para o grupo pré definido

Private Sub CommandButton1_Click()

ThisWorkbook.Save
Dim contato As String
Dim texto As Variant
Dim grafico As Variant
Dim linha As Integer

'GRAPH é a guia da planilha
Sheets("GRAPH").Select

linha = 2

' Shell "C:\Program Files\Google\Chrome\Application\chrome.exe" & " https://web.whatsapp.com/"
ActiveWorkbook.FollowHyperlink Address:=" https://web.whatsapp.com/"

Application.Wait (Now + TimeValue("00:00:08"))

Do Until Sheets("GRAPH").Cells(linha, 7) = ""

Application.Wait (Now + TimeValue("00:00:04"))

'texto é o intervalo de células onde está o gráfico que desejo copiar, contato é a célula onde está o nome do grupo
texto = Sheets("GRAPH").Range("A1:X77").Copy
grafico = ActiveSheet.Paste
contato = Cells(linha, 7)

Application.Wait (Now + TimeValue("00:00:04"))

Call SendKeys("{TAB}", True)

Application.Wait (Now + TimeValue("00:00:01"))

Call SendKeys(contato, True)

Application.Wait (Now + TimeValue("00:00:01"))

Call SendKeys("~", True) 'entra na tela do contato no WhatsApp

Application.Wait (Now + TimeValue("00:00:04"))

Call SendKeys(texto, True)
Call SendKeys(grafico, True)

Application.Wait (Now + TimeValue("00:00:01"))

Call SendKeys("~", True)

linha = linha + 1

Loop

MsgBox ("Notificação enviada com sucesso")

End Sub