Ir para conteúdo
Fórum Script Brasil

Fernando Oliveira Cabral

Membros
  • Total de itens

    1
  • Registro em

  • Última visita

Sobre Fernando Oliveira Cabral

Fernando Oliveira Cabral's Achievements

0

Reputação

  1. 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
×
×
  • Criar Novo...