Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Código do vídeo - Web Scraping com VBA e Application.SendKeys

Fórum para agrupar todas as propostas de modelos de planilhas de Excel que essa comunidade consegue imaginar. Teve uma idéia? Produziu algo bem bacana? Esse é o lugar!

Moderador: Rafael Monteiro

Avatar do usuário
webmaster
Administrador
Mensagens: 3114
Registrado em: Sex Jul 24, 2009 2:44 pm
Contato:

Código do vídeo - Web Scraping com VBA e Application.SendKeys

Mensagem por webmaster »

Vídeo:

https://youtu.be/1wgSxzwUSIQ

webScrappingSendKeys

Código: Selecionar todos

Sub WebScrappingIE()
    With Application
        .SendKeys "^{ESC}"
        .Wait Now + TimeValue("00:00:01")
        .SendKeys "Executar"
        .SendKeys "~"
        .Wait Now + TimeValue("00:00:01")
        .SendKeys "iexplore -nosessionmerging http://www2.correios.com.br/sistemas/precosPrazos/#ancora"
        .SendKeys "~"
        .Wait Now + TimeValue("00:00:05")
        .SendKeys "{TAB}{TAB}{TAB}{TAB}{TAB}"
        'Data da postagem:
        .SendKeys Format(DateAdd("d", 1, Now), "dd/MM/yyyy")
        .SendKeys "{TAB}{TAB}"
        'CEP de origem
        .SendKeys "01310-200" 'MASP - S„o Paulo
        .SendKeys "{TAB}{TAB}"
        'CEP de destino
        .SendKeys "20021-200" 'Museu Nacional do Rio de Janeiro
        .SendKeys "{TAB}{TAB}"
        'Tipo de serviÁo
        .SendKeys "PAC"
        .SendKeys "{TAB}{TAB}"
        'Embalagem
        .SendKeys "Embalagem"
        .SendKeys "{TAB}{TAB}"
        'Seleciona a caixa de encomenda
        .SendKeys " "
        .SendKeys "{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}"
        'Peso estimado
        .SendKeys "1"
        .SendKeys "{TAB}{TAB}{TAB}{TAB}"
        .SendKeys "10000"
        .SendKeys "{TAB}"
        .SendKeys "~" 'Enviar consulta
        .Wait Now + TimeValue("00:00:01")
        '.SendKeys "~"
        '.Wait Now + TimeValue("00:00:01")
        '.SendKeys "~"
        'Espera por uma nova p·gina
        .Wait Now + TimeValue("00:00:03")
        'navega atÈ a URL
        .SendKeys "{TAB}" 'vai para a barra de endereÁos
        .Wait Now + TimeValue("00:00:01")
        'javascript:document.write(document.getElementsByClassName('content')[1].outerHTML);
        .SendKeys "javascript+(;)document.write+(9)document.getElementsByClassName+(9)' content' +(0){[}1{]}.outerHTML+(0);"
        .SendKeys "~"
        .Wait Now + TimeValue("00:00:01")
        .SendKeys "^(a)" 'Seleciona tudo
        .Wait Now + TimeValue("00:00:01")
        .SendKeys "^(c)" 'Ctrl+C
        'coloca no resultado em uma nova planilha
        Dim novaPlanilha As Worksheet
        Set novaPlanilha = ThisWorkbook.Worksheets.Add
        novaPlanilha.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False
        'fecha o navegador
        .SendKeys "%{F4}"
    End With
End Sub

Sub Teste()
    With Application
        .SendKeys "^{ESC}"
        .Wait Now + TimeValue("00:00:01")
        .SendKeys "Executar"
        .SendKeys "~"
        .Wait Now + TimeValue("00:00:01")
        .SendKeys "notepad"
        .SendKeys "~"
        .Wait Now + TimeValue("00:00:01")
        .SendKeys "+(9)ol· notepad!' "
        '.SendKeys "javascript+(;)document.write+(9)document.getElementsByClassName+(9)' content' +(0){[}1{]}.outerHTML+(0);"
    End With
End Sub

modSelenium

Código: Selecionar todos

Dim driver As WebDriver

Sub ColetaDadosCorreios()
    Set driver = New ChromeDriver
    With driver
        .Get "http://www2.correios.com.br/sistemas/precosPrazos/"
        .FindElementById("data").SendKeys Format(DateAdd("d", 1, Now), "dd/MM/yyyy")
        .FindElementByName("cepOrigem").SendKeys "01310-200" 'MASP - S„o Paulo
        .FindElementByName("cepDestino").SendKeys "20021-200" 'Museu Nacional do Rio de Janeiro
        .FindElementByName("servico").AsSelect().SelectByText ("PAC")
        .FindElementByXPath("//*[@id=""spanFormato""]/img[1]").Click
        .FindElementByName("embalagem1").AsSelect().SelectByValue ("correiosEmbalagem1")
        .FindElementByXPath("//*[@id=""spanTipoEmbalagem""]/div/div[2]/div/div[1]/div/p/button").Click
        .FindElementByName("peso").AsSelect().SelectByValue ("1")
        .FindElementByName("valorDeclarado").SendKeys "10000"
        .FindElementByXPath("//*[@id=""spanBotao""]/input").Click
        .SwitchToNextWindow (1000)
        Dim novaPlanilha As Worksheet
        Set novaPlanilha = ThisWorkbook.Worksheets.Add
        .FindElementByXPath("/html/body/div[1]/div[3]/div[2]/div/div/div[2]/div[2]/div[2]/table").AsTable().ToExcel (novaPlanilha.Cells(1, 1))
        driver.Quit
    End With
End Sub


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


flavio-matos
Acabou de chegar
Acabou de chegar
Mensagens: 1
Registrado em: Seg Set 12, 2016 6:51 pm

Re: Código do vídeo - Web Scraping com VBA e Application.SendKeys

Mensagem por flavio-matos »

Obrigado por mais um conteúdo de grande qualidade. Sou novato em VBA e venho estudando e tentando a cada dia fazer simulações de diversas situações voltadas a WebScraping. Um amigo me pediu para fazer extração de resultados da página, tentei instalar o Selenium no Chrome Versão 74.0.3729.131 (Versão oficial) 64 bits, no Firefox Quantum 66.0.5 (64-bits). Ambos sem êxito, seria possível uma ajuda de como instalar versões dele e em quais navegadores funciona. Trechos de código, qualquer coisa que possa me apoiar nesse estudo? Desculpe a mensagem gigantesca.

[REMOVIDO POR LINK ESTAR QUEBRADO]

ou

[REMOVIDO POR LINK ESTAR QUEBRADO]


Mhenrique1502
Acabou de chegar
Acabou de chegar
Mensagens: 2
Registrado em: Seg Dez 09, 2019 10:18 am
Contato:

Re: Código do vídeo - Web Scraping com VBA e Application.SendKeys

Mensagem por Mhenrique1502 »

Material de ótima qualidade, como sempre.
Estou me aprofundando em webscraping e estou utilizando muito seu forum e seus videos no youtube.
Aquela serie de Internet Controls x Selenium estava demais, por que pararam?
Ademais, meus sinceros e profundo agradecimentos.


Julio Mangilli
Manda bem
Manda bem
Mensagens: 127
Registrado em: Sex Out 05, 2018 2:42 pm

Re: Código do vídeo - Web Scraping com VBA e Application.SendKeys

Mensagem por Julio Mangilli »

Olá Pessoal estou escrevendo esse código mas dei uma travada na hora de escolher o certificado digital, estou tentando usar o SendKeys, Será que eu consigo fazer esse processo?

Só gostaria de saber se não tem como , ou se tem algum método.

Sub ECACRA()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim Tempo As Double
Tempo = Now()

Dim driver As New Selenium.ChromeDriver
Set driver = New ChromeDriver
'driver.AddArgument ("--headless")



driver.Get "https://cav.receita.fazenda.gov.br/autenticacao/Login"

driver.FindElementById("caixa-login-certificado").Click

With Application
.SendKeys "{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}"
.SendKeys "~"
End with

While Busy
Application.Wait TimeSerial(Hour(Now), Minute(Now), Second(Now) + 1)
DoEvents:
Wend

driver.FindElementById("btn259").Click 'Pagamento e parcelamentos

While Busy
Application.Wait TimeSerial(Hour(Now), Minute(Now), Second(Now) + 1)
DoEvents:
Wend

driver.Get "https://cav.receita.fazenda.gov.br/ecac ... rigem=menu"

While Busy
Application.Wait TimeSerial(Hour(Now), Minute(Now), Second(Now) + 1)
DoEvents:
Wend

driver.FindElementByName("campoDataArrecadacaoInicial").SendKeys "01/01/2019"
driver.FindElementByName("campoDataArrecadacaoFinal").SendKeys "31/12/2019"


While Busy
Application.Wait TimeSerial(Hour(Now), Minute(Now), Second(Now) + 1)
DoEvents:
Wend

driver.FindElementById("botaoConsultar").Click

While Busy
Application.Wait TimeSerial(Hour(Now), Minute(Now), Second(Now) + 1)
DoEvents:
Wend


Dim destino As Range



driver.Get "https://cav.receita.fazenda.gov.br/ecac ... rigem=menu"

While Busy
Application.Wait TimeSerial(Hour(Now), Minute(Now), Second(Now) + 1)
DoEvents:
Wend

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

Dim tabela As TableElement

Set tabela = driver.FindElementByXPath("/html/body/div/form/div[3]/table/tbody/tr/td/div/table", timeout:=19000).AsTable '10000



'Print all cells
Dim data(): data = tabela.data
Set destino = Sheets("Tabela").Range("A1")







driver.Quit

Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox Now() - Tempo & " Gerado com Sucesso"

End Sub

Obrigado desde já.


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder