Excel Enviar WhatsApp com VBA

[Leandro Lamin]

Boa Noite,

Caros amigos estou com mais uma dúvida, estou aprendendo Vba.

Estou escrevendo um código juntando partes para utilizar VBA para automatizar mensagens do WATZAP.

estou compartilhando com o arquivo para quem poder dar uma olhada.

Creio que é simples mas ainda não consegui.

Obrigado!

WATZAP.rar

[Leandro Lamin]

Em 07/05/2022 às 20:28, Leandro Lamin disse:

Boa Noite,

Caros amigos estou com mais uma dúvida, estou aprendendo Vba.

Estou escrevendo um código juntando partes para utilizar VBA para automatizar mensagens do WATZAP.

estou compartilhando com o arquivo para quem poder dar uma olhada.

Creio que é simples mas ainda não consegui.

Obrigado!

WATZAP.rar 17 kB · 9 downloads

CONSEGUI CHEGAR NESSE CÓDIGO porém ELE COPIA IMAGEM. alguém SABE RETIRAR A IMAGEM?

 

 

Sub Excel_to_WhatsApp()
Dim r As Long
Dim Linha As Integer
Dim strip As String
Dim Numero_Telefone As String
Dim Mensagem As String
Dim Enviar As String
Dim Object As Object

r = Range("A" & Rows.Count).End(xlUp).Row
For Linha = 2 To r

Numero_Telefone = Planilha1.Cells(Linha, 1).Value
Mensagem = Planilha1.Cells(Linha, 2).Value

'ActiveSheet.Shapes(1).Copy

Enviar = "whatsapp://send?phone=" & Numero_Telefone & "&text=" & Mensagem

Set Object = CreateObject("InternetExplorer.Application")

Object.navigate Enviar

Application.Wait (Now + TimeValue("00:00:05"))
Call SendKeys("^v")

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

Call SendKeys("{Enter}", True)

'Application.Wait Now() + TimeSerial(0, 0, 5)
'SendKeys "~"

Next Linha
End Sub

WATZAP - tipo 1 .rar

[AfonsoMira]

@Leandro Lamin Boas,

 

Experimente assim:

Sub Excel_to_WhatsApp()
Dim r As Long
Dim Linha As Integer
Dim strip As String
Dim Numero_Telefone As String
Dim Mensagem As String
Dim Enviar As String
Dim Object As Object

r = Range("A" & Rows.Count).End(xlUp).Row
For Linha = 2 To r

Numero_Telefone = Planilha1.Cells(Linha, 1).Value
Mensagem = Planilha1.Cells(Linha, 2).Value

Planilha1.Cells(Linha, 2).copy

Enviar = "whatsapp://send?phone=" & Numero_Telefone & "&text=" & Mensagem

Set Object = CreateObject("InternetExplorer.Application")

Object.navigate Enviar

Application.Wait (Now + TimeValue("00:00:05"))
Call SendKeys("^v")

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

Call SendKeys("{Enter}", True)

'Application.Wait Now() + TimeSerial(0, 0, 5)
'SendKeys "~"

Next Linha
End Sub

PS. Não testei aqui

[Leandro Lamin]

2 horas atrás, AfonsoMira disse:

@Leandro Lamin Boas,

 

Experimente assim:

Sub Excel_to_WhatsApp()
Dim r As Long
Dim Linha As Integer
Dim strip As String
Dim Numero_Telefone As String
Dim Mensagem As String
Dim Enviar As String
Dim Object As Object

r = Range("A" & Rows.Count).End(xlUp).Row
For Linha = 2 To r

Numero_Telefone = Planilha1.Cells(Linha, 1).Value
Mensagem = Planilha1.Cells(Linha, 2).Value

Planilha1.Cells(Linha, 2).copy

Enviar = "whatsapp://send?phone=" & Numero_Telefone & "&text=" & Mensagem

Set Object = CreateObject("InternetExplorer.Application")

Object.navigate Enviar

Application.Wait (Now + TimeValue("00:00:05"))
Call SendKeys("^v")

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

Call SendKeys("{Enter}", True)

'Application.Wait Now() + TimeSerial(0, 0, 5)
'SendKeys "~"

Next Linha
End Sub

PS. Não testei aqui

 

Legal! vou testar!! Obrigado