Página 1 de 1

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

Enviado: Sáb Mai 11, 2019 2:53 am
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

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

Enviado: Sáb Mai 11, 2019 12:13 pm
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]

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

Enviado: Qua Dez 11, 2019 3:12 pm
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.

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

Enviado: Qui Dez 12, 2019 9:14 am
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á.