-
Total de itens
1 -
Registro em
-
Última visita
Sobre Fernando Oliveira Cabral
Fernando Oliveira Cabral's Achievements
0
Reputação
-
Comando Sendkeys, digitar um caractere por vez
uma questão postou Fernando Oliveira Cabral Visual Basic
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