[Resolvido]Pegando Endereço Pelo CEP nos Correios

Fala galera.

Esta é minha primeira ajuda que peço aqui no fórum.

Pois bem, estou montando alguns sistemas e vou implementar o sistema de preenchimento automático de endereço com base no CEP.
Existem alguns modelos em diversos repositórios por ai, mas, não encontrei nenhum que faça a busca no site dos correios.

Depois de pesquisar e estudar bastante, consegui fazer a busca no site dos correios e consegui resgatar os dados para utilizar no sistema.
Mas nem tudo são flores.

Não sou nenhum expert em VB, mas consigo me virar bem com tutoriais e exemplos.

O sistema esta fazendo o que precisa, porém em duas etapas, caso contrário gera erro, vamos aos códigos:

Código após atualizar o campo de CEP

Código:

Dim html

Private Sub cep_AfterUpdate()
Dim elementos
Dim elem
Dim correios As String

correios = "http://m.correios.com.br/movel/buscaCepConfirma.do"

Me.ie.Visible = True

Me.ie.Navigate correios

Me.ie.SetFocus

'Aguardo até que a página esteja totalmente carregada
Do While Me.ie.Busy = True
DoEvents
Loop

Set html = Me.ie.Document

html.all("cepEntrada").Value = campo_cep

For Each elementos In html.getElementsByTagName("input")
If elementos.Type = "submit" Then elementos.Click: Exit For
Next

Set html = Nothing
End Sub

Resumindo o código acima, após atualizar o CEP exibimos o navegador e fazemos a busca do CEP informado no campo.
Só que se eu tentar resgatar os dados neste mesmo evento ele simplesmente carrega os dados da página antes de fazer a busca do CEP

Então eu joguei o resgate dos dados em um novo evento de um botão e ai sim, ele funciona

Código:

Private Sub Comando2_Click()

Set html = Me.ie.Document

Dim todotexto, inicio, fim, rua
Dim incremento, total, total1, bairro, cidade, estado, cidade_est

todotexto = html.DocumentElement.outerHTML

incremento = 0

todotexto = Right(todotexto, Len(todotexto) - incremento)

inicio = InStr(todotexto, "<SPAN class=respostadestaque>") 'dá a posição da primeira ocorrência de "td" em todo texto
fim = InStr(todotexto, "</SPAN><BR><SPAN class=resposta>")

inicio = inicio + 29

'rua = Mid(todotexto, inicio, fim - inicio)
Texto12 = Mid(todotexto, inicio, fim - inicio)

incremento = fim

todotexto = Right(todotexto, Len(todotexto) - incremento)

inicio = InStr(todotexto, "<SPAN class=respostadestaque>") 'dá a posição da primeira ocorrência de "td" em todo texto
fim = InStr(todotexto, "</SPAN><BR><SPAN class=resposta>")

inicio = inicio + 29

'bairro = Mid(todotexto, inicio, fim - inicio)
Texto19 = Mid(todotexto, inicio, fim - inicio)

incremento = fim

todotexto = Right(todotexto, Len(todotexto) - incremento)

inicio = InStr(todotexto, "<SPAN class=respostadestaque>") 'dá a posição da primeira ocorrência de "td" em todo texto
fim = InStr(todotexto, "</SPAN><BR><SPAN class=resposta>")

inicio = inicio + 29

cidade_est = Mid(todotexto, inicio, fim - inicio)

Texto21 = Left(cidade_est, Len(cidade_est) - 5)

estado = Right(cidade_est, 3)

Set html = Nothing

Me.ie.Visible = False

End Sub

Outro erro que ocorre também é ao tentar, fazer uma nova consulta, ai obtenho o erro:

Erro em tempo de execução '438':
O objeto não aceita esta propriedade ou método

E só volta a funcionar se fechar e abrir o formulário novamente.

Então, gostaria da ajuda de vocês para resolver estes erros e verificar se posso melhorar o código de alguma forma.

Obrigado.

Consegui resolver o problema ao tentar fazer uma nova consulta.

Agora só falta conseguir fazer a consulta e o resgate das informações em um único evento.

T+

Boa tarde, companheiro. Seja bem-vindo!

Eu estava a te responder com uma solução para fazer uma nova consulta, mas reparo que você já o fez. (rsrs)

De qualquer forma vou postar abaixo a minha solução e você decide qual prefere usar.

Inseri uma checagem de "ReadyState" logo após a checagem de "Busy".
Isso impede que o valor da variável campo_cep seja inserido no controle cepEntrada antes que a página seja carregada completamente. Segue:

Código:


Do While Me.ie.Busy = True
DoEvents
Loop

Do While Me.ie.ReadyState <> 4
DoEvents
Loop


No caso de resgatar as informações no mesmo evento eu ainda não consegui.

Bom estudo, rtcoelho!

Léo Picoli

Valeu Léo.

Descobri o problema em pegar os dados no mesmo evento.
É por causa de um java que roda na página, a consulta é feita via ajax.

Com isso para o sistema a página está carregada, mas ela ainda tem um atraso causado pelo ajax fazendo a consulta.
Tentei simular atrasos no evento, mas não funciona, durante o atraso parece que a página pausa só carregando o ajax quando há outro evento.

Consegui chegar a esta conclusão fazendo um evento dentro do mesmo evento, fiz isto exibindo uma MsgBox, quando a MsgBox é exibida o ajax carrega e ao fechar a MsgBox o condigo continua deste ponto e pega os dados dos correios e joga no formulário.

Estou disponibilizando um exemplo pra galera de como ficou, mas tem muita coisa para melhorar e se alguém puder me ajudar a passar por cima deste problema descrito acima, serei grato.

Olá rtcoelho

Fiz os testes aqui funcionou legal!

Não entendo muito de buscar dados da internet vou utilizar seu exemplo para estudar.

Parabéns.

Valeu Mrsilva.

Sim, desta forma que fiz está funcionando perfeitamente, mas não está do jeito que gostaria.
Preciso resolver este problema, para que possa executar o procedimento sem a necessidade da msgbox confirmando o CEP digitado.

T+

Porque não cria uma função e a chama no final do evento do primeiro?

Dim html

Private Sub cep_AfterUpdate()
Dim elementos
Dim elem
Dim correios As String

correios = "http://m.correios.com.br/movel/buscaCepConfirma.do"

Me.ie.Visible = True

Me.ie.Navigate correios

Me.ie.SetFocus

'Aguardo até que a página esteja totalmente carregada
Do While Me.ie.Busy = True
DoEvents
Loop

Set html = Me.ie.Document

html.all("cepEntrada").Value = campo_cep

For Each elementos In html.getElementsByTagName("input")
If elementos.Type = "submit" Then elementos.Click: Exit For
Next

Set html = Nothing
Call SuaFucao
End Sub

Cumprimentos.

Piloto, você diz isto para melhorar o código ou para resolver o problema?

Pois eu já fiz este teste para ver se resolve o problema, mas não resolveu.

O código atual está bem melhorado, veja o exemplo que postei neste link:

http://maximoaccess.forumeiros.com/t13127-buscar-cep-nos-correios

Ele também está funcional, porém, para resolver este problema, eu coloquei uma Msgbox antes de pegar os dados do endereço que os correios retorna.

Gostaria de fazer isso sem precisar da Msgbox.

T+

Esta anexada na primeira mensagem?

Cumprimentos.

No anexo deste post http://maximoaccess.forumeiros.com/t13127-buscar-cep-nos-correios

T+

Primeiramente tratamos o Erro de número 5 que ocorre para quando o CEP for genêrico, ou seja, da cidade e não contiver nome de Bairro ou rua, e para o outro caso um procedimento utilizando uma função que pausa o código por alguns segundos, neste caso transformamos o cursor do mouse em uma ampulheta para que o usuário aguarde a consulta.

Em um módulo:

Public Function Pause(NumberOfSeconds As Variant)
On Error GoTo Err_Pause
    
    Dim PauseTime As Variant, start As Variant
    
    PauseTime = NumberOfSeconds
    start = Timer
    Do While Timer < start + PauseTime
    DoEvents
    Loop
    
Exit_Pause:
    Exit Function
    
Err_Pause:
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_Pause
    
End Function

No Código:

'Sistema para buscar CEP direto no site dos correios online.
'Desenvolvido por: Rafael Teixeira Coelho - rtcoelho no fórum maximoaccess
'Versão 1.0 Beta

Private Sub cep_AfterUpdate()
'-----------------------------------------------
'Tratamento de Erros
On Error GoTo TrataErro
'-----------------------------------------------
Dim todotexto, inicio, fim, incremento, cidade_est

'Exibe o objeto do IE
Me.ie.Visible = True

'Navega até o site dos Correios mobile
Me.ie.Navigate "http://m.correios.com.br/movel/buscaCepConfirma.do"

'Move o foco para o objeto
Me.ie.SetFocus

'Aguardo até que a página esteja totalmente carregada
Call aguardar(ie, 1)

'Seta variavel html com a classe mais comum do objeto
Set html = Me.ie.Document

'Localiza no site dos correios o campo do CEP e injeta
html.all("cepEntrada").Value = cep

'Depois do CEP injetado fazemos a busca
html.getElementsByTagName("input")(3).Click
'Ativa a ampulheta
DoCmd.Hourglass True
'Executa função que aguarda que a página esteja totalmente carregada
Call aguardar(ie, 1)
'Adiciona um pause de 2 segundos no código
Pause (2)
'Desativa a ampulheta
DoCmd.Hourglass False
'-------------------------------------------------------------------------------------------------------------------------------
'Como o site dos correios usa ajax para fazer a consulta, se não gerarmos um evento antes de pegar os dados, teremos um erro
'Mais detalhes em: http://maximoaccess.forumeiros.com/post?t=13087
'Então, já que terei que fazer este evento, resolvi fazer uma confirmação do CEP digitado
'pergunta = MsgBox("O CEP informado " & cep & " está correto?", vbYesNo)
'-------------------------------------------------------------------------------------------------------------------------------
'Caso a resposta seja sim, vamos pegar no site dos correios o que nos interessa
'If pergunta = 6 Then

'Pegamos o html da página
todotexto = html.DocumentElement.outerHTML

'Vamos usar um incremento para nos auxiliar na busca dos dados
incremento = 0

'Lemos o html da página e pegamos o endereço
todotexto = Right(todotexto, Len(todotexto) - incremento)

'Aqui verificamos se ocorreu algum erro no código por cep inválido
If InStr(todotexto, "
") = 0 Then

'Pegamos a posição da primeira ocorrência de resposta em todo texto que traz o endereço
inicio = InStr(todotexto, "")

'Pegamos a posição final da primeira ocorrência de resposta em todo texto que traz o endereço
fim = InStr(todotexto, "
")

'Somamos a quantidade de caracteres exedentes da primeira ocorrencia que é  = 29
inicio = inicio + 29

'Fazemos o recorte do html conforme as posições informadas para obter o endereço e inserir no formulário
endereco = Mid(todotexto, inicio, fim - inicio)

'Definimos nova posição de incremento para auxiliar na busca dos dados
incremento = fim

'Lemos o html da página e pegamos o bairro
todotexto = Right(todotexto, Len(todotexto) - incremento)

'Pegamos a posição da segunda ocorrência de resposta em todo texto que traz o bairro
inicio = InStr(todotexto, "")

'Pegamos a posição final da segunda ocorrência de resposta em todo texto que traz o bairro
fim = InStr(todotexto, "
")

'Somamos a quantidade de caracteres exedentes da segunda ocorrencia que é  = 29
inicio = inicio + 29

'Fazemos o recorte do html conforme as posições informadas para obter o bairro e inserir no formulário
bairro = Mid(todotexto, inicio, fim - inicio)

'Definimos nova posição de incremento para auxiliar na busca dos dados
incremento = fim

'Lemos o html da página e pegamos a cidade e o estado que estão juntos
todotexto = Right(todotexto, Len(todotexto) - incremento)

'Pegamos a posição da terceira ocorrência de resposta em todo texto que traz a cidade e o estado
inicio = InStr(todotexto, "")

'Pegamos a posição final da terceira ocorrência de resposta em todo texto que traz a cidade e o estado
fim = InStr(todotexto, "
")

'Somamos a quantidade de caracteres exedentes da terceira ocorrencia que é  = 29
inicio = inicio + 29

'Em uma variavel, fazemos o recorte do html conforme as posições informadas para obter a cidade e o estado
cidade_est = Mid(todotexto, inicio, fim - inicio)

'Fazemos o recorte do html para separar a cidade que está junto com o estado e inserir no formulário
Cidade = Left(cidade_est, Len(cidade_est) - 5)

'Fazemos o recorte do html para separar a cidade que está junto com o estado e inserir no formulário
estado = Right(cidade_est, 3)

Else

'Se o CEP estiver errado, informamos
MsgBox "CEP inválido, verifique e tente novamente."

'Limpa os campos do formulários
cep = ""
endereco = ""
bairro = ""
Cidade = ""
estado = ""

End If
'-------------------------------------------------------------------
'Else

'Se clicar em não na confirmação do cep, limpamos o form do cep
'cep = ""

'End If
'-------------------------------------------------------------------

'Limpamos
Set html = Nothing

'Movemos o foco para o campo CEP
cep.SetFocus

'Ocultamos o objeto do IE
Me.ie.Visible = False


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Tratamento de Erros
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exit_TrataErro:
DoCmd.Hourglass False
DoCmd.Echo True
Exit Sub
TrataErro:
Select Case Err.Number
Case 5
Resume Next
Case Else
DoCmd.Hourglass False
DoCmd.Echo True
MsgBox "Erro Gerado no: frmCursos (Procecimento XXXX)" _
& vbNewLine & "Erro Número: " & Err.Number _
& vbNewLine & "linha: " & Erl _
& vbNewLine & "Descrição: " & Err.Description _
& vbNewLine & "Por favor contate o Administrador de Sistema.", vbCritical, Err.Number & ", linha:" & Erl
End Select

End Sub

Cumprimentos.

Valeu Piloto.

Funcionou perfeitamente.

Eu havia tentado algo parecido, mas não obtive exito, mas da forma que você fez ficou perfeito.

Já lancei a versão 1.1b em http://maximoaccess.forumeiros.com/t13127-buscar-cep-nos-correios

T+

O Fórum agradece o Retorno.

Uma pergunta: dá para usar o mesmo método, ou de uma forma semelhante, para obter localização do Google Maps num formulário?

muito obrigado pelas informações

Estou mais para leiga realmente em Access, mas a curiosidade é grande.. .

baixei o seu arquivo de procura endereço pelo CEP, maravilha funciona perfeitamente.

Contudo qdo copie o formulário e  o modulo para um arquivo meu já existente, ele não funciona.

Erro de compilação: Variável não Definida

With ObjIe
   Do Until

Bom dia LEIGA,


Baixei o exemplo também aqui tá normal.

Faça a seguinte verificação, no modo estrutura do form, vá em Exibi código/ Ferramentas / Referências e vejas se tem alguma AUSENTE, se tiver marque ao lado, devendo estar como a figura abaixo:

[img][/img]

Esta ultima versão ficou bacana contudo eu tenho tido problemas com um erro access 49 não sei identificar meu palpite que seja permissões de internet pois na minha maquina particular funciona certinho.