Jump to content
Fórum Script Brasil
  • 0

Comando Sendkeys, digitar um caractere por vez


Question

Olá, estou criando um procedimento bem simples, para envio de sms através de uma lista de contatos no excel.

A execução vai bem, até o momento da busca do contato, nesse momento o site recebe a informação mas por ser case sensitive ele não faz a restrição automática normalmente, ele demora muito pra trazer o resultado e no tempo programado ele continua a ação, porém, sem localizar o contato.

A solução, através de testes realizados é que na digitação a cada caractere a busca acontece quase instantaneamente.

ALguma luz?

 

Sub Enviar()

'não pode fazer clicks ou mudar o foco do mause nem pressionar teclas
Dim text As String
Dim Contato As String

text = Sheets(1).TextBox1

If text = "" Then
MsgBox "Digite a Mensagem a ser envida!", 64, "ERRO DE PROCEDIMENTO"
Exit Sub
End If

ActiveWorkbook.FollowHyperlink Address:=" https://messages.google.com/web"
'Shell "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" & " https://https://messages.google.com/web"

Fazer (15000)
 
linha = 8
Do Until Sheets(1).Cells(linha, 1) = ""

Fazer (2000)
Contato = Cells(linha, 1)

If Contato = "" Then
MsgBox "Preencha os endereços de contatos!", 64, "Insira pelo menos um Contato"
Exit Sub
End If

Fazer (2000)
 Call SendKeys("{TAB}", True)
Fazer (2000)
 Call SendKeys("{TAB}", True)
Fazer (2000)
 Call SendKeys("{ENTER}", True)
 Fazer (2000)

'aqui é onde ocorre o problema
Call SendKeys(Contato, True)
 Fazer (20000)
 Call SendKeys("{TAB}", True)
 Fazer (2000)
 Call SendKeys("{ENTER}", True)
 Fazer (2000)
 Call SendKeys(text, True)
 Fazer (2000)
 Call SendKeys("{ENTER}", True)
 
 

linha = linha + 1

Loop

'ActiveWorkbook.FollowHyperlink Address:=" https://web.whatsapp.com/"
'Shell "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" & " https://web.whatsapp.com/"
' 'Application.Wait TimeSerial(0, 0, 1)
' Fazer (7000)
' SendKeys "{TAB}", True
'' SendKeys "camilly", True
' Call SendKeys(text, True)
'SendKeys "{ENTER}", True
'
'Fazer (2000)
'Call SendKeys(text, True)
'SendKeys "{ENTER}", True
'Call SendKeys("~", True)


End Sub

Function Fazer(ByVal Acao As Double)

Application.Wait (Now() + Acao / 24 / 60 / 60 / 1000)

'milliSeconds
End Function

 

Link to post
Share on other sites

0 answers to this question

Recommended Posts

There have been no answers to this question yet

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Cloud Computing


  • Forum Statistics

    • Total Topics
      149151
    • Total Posts
      645419
×
×
  • Create New...