MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

2 participantes

    [Resolvido]Extrair informação da Web e inserir em Tabela

    avatar
    Nill2013Br
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 34
    Registrado : 14/05/2013

    [Resolvido]Extrair informação da Web e inserir em Tabela Empty [Resolvido]Extrair informação da Web e inserir em Tabela

    Mensagem  Nill2013Br 29/11/2021, 16:24

    Amigos, Estou quebrando a cabeça e não consegui avançar na solução. Este código eu estou adaptando com o Selenium VBA para poder usar com Google Chrome ou Edge. Não consegui encontrar uma alternativa para que quando preencher a informação do CEP na tabela FAIXA_CEP e continuar fazendo a pesquisa tendo um novo resultado preencher a próxima linha. Se puderem me ajudar e indicar material para estudo, fico agradecido.



    Código:

    Option Compare Database
    Sub lsPesquisarCEPFaixa()

    Dim lCidade As String
    Dim lUF As String
    Dim rsUF As DAO.Recordset
    Dim rsCID As DAO.Recordset
    Dim lUltimaLinhaAtiva As Long
    Dim sng


    'Declara Variáveis Access
    Dim rsSQL As DAO.Recordset

    'o recordset carrega apenas os registros que nao estejam preenchidos a faixa de cep
    Set rsSQL = CurrentDb().OpenRecordset("Select * from Tabela1 where isnull (Faixa_Cep)")

    'so executa se houver dados
    If rsSQL.RecordCount > 0 Then

    'esses dois codigos é necessario para a funcao RecordCount retornar o valor correto dos registros
    rsSQL.MoveLast
    rsSQL.MoveFirst

    End If
    lUltimaLinhaAtiva = rsSQL.RecordCount


    Set driver = New ChromeDriver
    'Set driver = New EdgeDriver

    'Abre site a ser consultado
    driver.Get "https://buscacepinter.correios.com.br/app/faixa_cep_uf_localidade/index.php"

    'Espera carregar a página
    sng = Timer
    Do While sng + 3 > Timer
    Loop


    Set rsUF = CurrentDb.OpenRecordset("SELECT ESTADO FROM Tabela1")
    Set rsCID = CurrentDb.OpenRecordset("SELECT LOCALIDADE FROM Tabela1")


    'Envia dados para consulta
    Do While Not rsCID.EOF
    driver.FindElementByXPath("//select[@id='uf']").SendKeys rsUF!ESTADO
    driver.FindElementByXPath("//input[@id='localidade']").SendKeys rsCID!LOCALIDADE
    driver.FindElementByXPath("//button[@id='btn_pesquisar']").Click

    'Espera Carregar a página
    sng = Timer
    Do While sng + 3 > Timer
    Loop

    'Define a tabelaDim Tabela As WebElement
    Set Tabela = driver.FindElementByXPath("/html[1]/body[1]/main[1]/form[1]/div[1]/div[2]/div[1]/div[3]/div[1]/table[1]/tbody[1]")

    'Pega o dado consultado e atualiza informação na Tabela


    ****Nesta parte eu não consegui uma solução para pular para a próxima linha
    CurrentDb.Execute "UPDATE Tabela1 SET FAIXA_CEP = '" & driver.FindElementByXPath("/html[1]/body[1]/main[1]/form[1]/div[1]/div[2]/div[1]/div[3]/div[1]/table[1]/tbody[1]/tr[1]/td[2]").Text & "' WHERE Linha = 1"

    '

    Retorna para o campo de pesquisa
    driver.FindElementByXPath("//button[@id='btn_voltar']").Click

    'Move para a próxima cidade
    rsCID.MoveNext


    Loop


    'Finalizada a consulta fecha o navegador
    driver.Quit

    'Fecha e Limpa variáveis
    rsUF.Close
    rsCID.Close

    Set rsUF = Nothing
    Set rsCID = Nothing
    Set rsFX = Nothing

    End Sub
    Anexos
    [Resolvido]Extrair informação da Web e inserir em Tabela AttachmentAccess Pesquisa Cep Web.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (44 Kb) Baixado 53 vez(es)
    Alexandre Fim
    Alexandre Fim
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2594
    Registrado : 13/12/2016

    [Resolvido]Extrair informação da Web e inserir em Tabela Empty Re: [Resolvido]Extrair informação da Web e inserir em Tabela

    Mensagem  Alexandre Fim 29/11/2021, 17:27

    Olá Nilton,

    Voce pretende recuperar dados de faixa de cep ou pretende carregar o endereço de um cep específico?



    .................................................................................
    Arrow  Marcar tópico como Resolvido: clique aqui
    Arrow  Postar anexos no fórum: clique aqui

    [Resolvido]Extrair informação da Web e inserir em Tabela Setinf11
    Sistemas e Tecnologia Ltda
    avatar
    Nill2013Br
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 34
    Registrado : 14/05/2013

    [Resolvido]Extrair informação da Web e inserir em Tabela Empty Re: [Resolvido]Extrair informação da Web e inserir em Tabela

    Mensagem  Nill2013Br 29/11/2021, 18:23

    Alexandre,

    Eu quero baixar a faixa de CEP da Cidade para a tabela.
    Alexandre Fim
    Alexandre Fim
    Developer
    Developer


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2594
    Registrado : 13/12/2016

    [Resolvido]Extrair informação da Web e inserir em Tabela Empty Re: [Resolvido]Extrair informação da Web e inserir em Tabela

    Mensagem  Alexandre Fim 29/11/2021, 18:45

    CErto...entendi


    .................................................................................
    Arrow  Marcar tópico como Resolvido: clique aqui
    Arrow  Postar anexos no fórum: clique aqui

    [Resolvido]Extrair informação da Web e inserir em Tabela Setinf11
    Sistemas e Tecnologia Ltda
    avatar
    Nill2013Br
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 34
    Registrado : 14/05/2013

    [Resolvido]Extrair informação da Web e inserir em Tabela Empty Re: [Resolvido]Extrair informação da Web e inserir em Tabela

    Mensagem  Nill2013Br 3/12/2021, 16:00

    Após várias tentativas cheguei no código abaixo que está funcionando. Não sei se está com as melhores práticas no funcionamento, testei com a situação que tenho e está fazendo o que eu queria. Fica disponível para quem quiser estudar e melhorar.

    Código:
    Sub lsPesquisarCEPFaixa1()

    'Declara Variáveis Access
    Dim rsSQL                As DAO.Recordset
    Dim lUltimaLinhaAtiva    As Long
    Dim lContador            As Long
    Dim sng

    'O recordset carrega apenas os registros que nao estejam preenchidos a faixa de cep
    Set rsSQL = CurrentDb().OpenRecordset("Select * from Tabela1 where isnull (Faixa_Cep)")

    'Só executa se houver dados
    If rsSQL.RecordCount > 0 Then

    'esses dois codigos são necessários para a funcao RecordCount retornar o valor correto dos registros
    rsSQL.MoveLast
    rsSQL.MoveFirst

    'Varíavel da Última Linha
    lUltimaLinhaAtiva = rsSQL.RecordCount

    End If

    Set driver = New ChromeDriver
    'Set driver = New EdgeDriver

    'Abre site a ser consultado
    driver.Get "https://buscacepinter.correios.com.br/app/faixa_cep_uf_localidade/index.php"

    'Aguarda a página da Web carregar
        sng = Timer
        Do While sng + 3 > Timer
        Loop


    Set rsUF = CurrentDb.OpenRecordset("SELECT ESTADO FROM Tabela1")
    Set rsCID = CurrentDb.OpenRecordset("SELECT LOCALIDADE FROM Tabela1")

    For lContador = 1 To lUltimaLinhaAtiva

    'Envia dados para consulta
    driver.FindElementByXPath("//select[@id='uf']").SendKeys rsUF!ESTADO
    driver.FindElementByXPath("//input[@id='localidade']").SendKeys rsCID!LOCALIDADE
    driver.FindElementByXPath("//button[@id='btn_pesquisar']").Click

    'Aguarda a página da Web carregar
        sng = Timer
        Do While sng + 3 > Timer
        Loop

    'Define a tabela
    Dim Tabela As WebElement
    Set Tabela = driver.FindElementByXPath("/html[1]/body[1]/main[1]/form[1]/div[1]/div[2]/div[1]/div[3]/div[1]/table[1]/tbody[1]")

    'Atualiza informação na Tabela
    CurrentDb.Execute "UPDATE Tabela1 SET FAIXA_CEP = '" & driver.FindElementByXPath("/html[1]/body[1]/main[1]/form[1]/div[1]/div[2]/div[1]/div[3]/div[1]/table[1]/tbody[1]/tr[1]/td[2]").Text & "' WHERE LINHA = " & lContador

    'Volta para a tela de pesquisa para inserir novo parâmetro caso exista
    driver.FindElementByXPath("//button[@id='btn_voltar']").Click

    'Move para a próxima cidade da tabela, caso exista
    rsCID.MoveNext

        Next

    'End If

    'Encerra o navegador
    driver.Quit

    'Fecha os Objetos
    rsUF.Close
    rsCID.Close
    rsSQL.Close

    'Limpa a memória
    Set rsUF = Nothing
    Set rsCID = Nothing
    Set rsSQL = Nothing

    End Sub


    avatar
    Nill2013Br
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 34
    Registrado : 14/05/2013

    [Resolvido]Extrair informação da Web e inserir em Tabela Empty Re: [Resolvido]Extrair informação da Web e inserir em Tabela

    Mensagem  Nill2013Br 3/12/2021, 16:06

    Resolvido

      Data/hora atual: 24/9/2022, 20:48