CEP onLine (erros)

Oi boa noite!
Deve ser problema na base dos correios porque aqui sempre funcionou normalmente e agora parou também.

já voltou a funcionar, é só testar, não esqueça que tem que ta conectado

Como que eu faço para que as informações geradas por esse formulário para componham uma tabela?

ola boa noite! sou novo no access, acabo de iniciar o curso de vba, mas ainda vai demorar pra eu me virar sozinho. sou curioso e costumo montar sistemas, verdadeiros "Frankenstein's".

 estou precisando de uma pequena ajuda com um erro na busca do CEP. quando o CEP não existe ou foi digitado errado, ele
retorna um erro e entra em modo depuração. a mensagem é "subscrito fora do intervalo" e "erro em tempo de execução 9''.

só falta resolver esse detalhe para ficar nota 10!  

este é o código:



Option Compare Database
Private Sub VerificarCEP()
'
' Exemplo de utilização
'

Dim resultado
Dim Texto As String
resultado = busca_cep(Me.CEP)

Dim i As Integer
Dim X As String
For i = 0 To 14

X = X & Chr(13) & resultado(i)
Next

Select Case resultado(2)

Case "2"
Me.Cidade = resultado(
Me.uf = resultado(5)

Case "1"
Me.End = resultado(12) & " " & resultado(14)
Me.Bairro = resultado(10)
Me.Cidade = resultado(
Me.uf = resultado(6)
Case Else

   MsgBox Me.CEP & Me.CEP & " não existe na base de dados, verifique...", vbCritical, "Atenção"
   Me.Undo


Me.CEP = Null
Me.End = Null
Me.Bairro = Null
Me.Cidade = Null
Me.uf = Null

End Select

End Sub

Function busca_cep(CEP)

url = "http://republicavirtual.com.br/web_cep.php?cep=" & CEP & "&formato=query_string"

Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlhttp.Open "GET", url, False
xmlhttp.Send ""

xmlhttp_resultado = xmlhttp.responseText
Set xmlhttp = Nothing

arr_resultado = Split(xmlhttp_resultado, "&")

Dim resultado(7)
For i = LBound(arr_resultado) To UBound(arr_resultado)

resultado(i) = arr_resultado(i)         ' --------------------------------------------- (aqui fica marcado em amarelo logo que editor abre)

Next

arr = Split(Join(resultado, "="), "=")

Dim arr_2(14)
For i = LBound(arr) To UBound(arr)

arr_2(i) = Replace(arr(i), "+", " ")

Next

busca_cep = arr_2
End Function

Private Sub btnEstrutura_Click()
DoCmd.OpenForm "clientes1", acDesign
End Sub

Private Sub btnFechar_Click()
Application.Quit
End Sub

Private Sub CEP_AfterUpdate()

Call VerificarCEP

If Not IsNull(Me.End) And Not IsNull(Me.Bairro) And Not IsNull(Me.Cidade) Then

Me.End = Replace(Me.End, "%E1", "á")
Me.End = Replace(Me.End, "%E2", "â")
Me.End = Replace(Me.End, "%E3", "ã")
Me.End = Replace(Me.End, "%E7", "ç")
Me.End = Replace(Me.End, "%E9", "é")
Me.End = Replace(Me.End, "%EA", "ê")
Me.End = Replace(Me.End, "%ED", "í")
Me.End = Replace(Me.End, "%F3", "ó")
Me.End = Replace(Me.End, "%F4", "ô")
Me.End = Replace(Me.End, "%F5", "õ")
Me.End = Replace(Me.End, "%FA", "ú")

Me.Bairro = Replace(Me.Bairro, "%E1", "á")
Me.Bairro = Replace(Me.Bairro, "%E2", "â")
Me.Bairro = Replace(Me.Bairro, "%E3", "ã")
Me.Bairro = Replace(Me.Bairro, "%E7", "ç")
Me.Bairro = Replace(Me.Bairro, "%E9", "é")
Me.Bairro = Replace(Me.Bairro, "%EA", "ê")
Me.Bairro = Replace(Me.Bairro, "%ED", "í")
Me.Bairro = Replace(Me.Bairro, "%F3", "ó")
Me.Bairro = Replace(Me.Bairro, "%F4", "ô")
Me.Bairro = Replace(Me.Bairro, "%F5", "õ")
Me.Bairro = Replace(Me.Bairro, "%FA", "ú")

Me.Cidade = Replace(Me.Cidade, "%E1", "á")
Me.Cidade = Replace(Me.Cidade, "%E2", "â")
Me.Cidade = Replace(Me.Cidade, "%E3", "ã")
Me.Cidade = Replace(Me.Cidade, "%E7", "ç")
Me.Cidade = Replace(Me.Cidade, "%E9", "é")
Me.Cidade = Replace(Me.Cidade, "%EA", "ê")
Me.Cidade = Replace(Me.Cidade, "%ED", "í")
Me.Cidade = Replace(Me.Cidade, "%F3", "ó")
Me.Cidade = Replace(Me.Cidade, "%F4", "ô")
Me.Cidade = Replace(Me.Cidade, "%F5", "õ")
Me.Cidade = Replace(Me.Cidade, "%FA", "ú")

End If

End Sub

agradeço quem puder resolver! obrigado!

boas...apenas um pitaco.


O CEP tem que estar separado por pontos, sem os pontos ele deu erro de execução aqui para mim.

Ex: XX.XXX.XXX

Creio que com a mascara de entrada, resolve seu problema.

ola Silvio!  Obrigado por responder!  

ainda não deu certo. tentei mascara na tabela, no formulário, tentei  digitar com os
pontos e traço, sem traço, só pontos... e nada, sempre retorna o erro. testei no original q baixei aqui e
todos os accdb CEP que uso pra testes estão com o mesmo comportamento.

eu uso o office 2007, minha maquina é 32. wim 7.

bom, estou usando assim, mas em breve terei uma pessoa me ajudando e tenho medo que esse faça algo errado...
se puder desativar essa rotina de abrir essa janela de erro, sei que não resolve, mas vai evitar danos piores.

obrigado até aqui!

silvio, olá mais uma vez!

acho que consegui resolver usando uma dica do crysostomo que vi aqui:

https://www.maximoaccess.com/t38122-resolvidoo-sistema-entrar-em-deputr


coloquei antes da linha q aparece o erro. funcionou muito bem!

arr_resultado = Split(xmlhttp_resultado, "&")

Dim resultado(7)
For i = LBound(arr_resultado) To UBound(arr_resultado)

On Error Resume Next               '------------------------------------------------( coloquei aqui onde apresentava o erro )

resultado(i) = arr_resultado(i)

Next

arr = Split(Join(resultado, "="), "=")

Dim arr_2(14)
For i = LBound(arr) To UBound(arr)

arr_2(i) = Replace(arr(i), "+", " ")

Next





   Bom, de toda forma obrigado pela ajuda!
espero que possa ajudar alguém com o mesmo problema!

até a proxima!

Boas...

No meu aqui com Win10 64Bits, Office 2010 32Bits deu somente aquele erro, mas bastou colocar a mascara de entrada e foi tudo certinho.

Melhor ainda que resolveu.

O fórum agradece o retorno.