PESQUISAR CEP PELA INTERNET SEM USAR O INTERNET EXPLORER

[rafaelsetti]

BOA TARDE,

TEM ALGUM CÓDIGO EM VBA PARA PESQUISA CEP (ENDEREÇO, N, BAIRRO, CEP, CIDADE, UF) SEM UTILIZAR O INTERNET EXPLORER, POIS PRECISO INSTALAR UM SOFTWARE EM UMA CLINICA E LÁ USA UM WINDOWS XP COMO NÃO DÃO MAIS SUPORTE PARA ESTE WINDOWS NECESSITA DE ATUALIZAÇÃO PARA O INTERNET EXPLORER PARA UTILIZAÇÃO DESTE RECURSO DO CÓDIGO QUE EU TENHO PARA ESTA PESQUISA QUE USA O INTERNET EXPLORER, NO 8 ELE NÃO RODA, PODEM ME AJUDAR COM OUTRO CÓDIGO ??? PARA PESQUISAR O CAMPO DA PESQUISA É TEXTCEP.TEXT.

OBRIGADO,

RAFAEL

[Basole]

Rafael veja se atende:

Sub lsPesquisaCEP(ByVal sCEP As String)
    On Error GoTo TratarErro
    
    Range("Plan2!a1:H1").Clear
    
    If sCEP <> "" Then
        With ActiveWorkbook.XmlMaps("webservicecep_Mapa")
            .ShowImportExportValidationErrors = False
            .AdjustColumnWidth = True
            .PreserveColumnFilter = False
            .PreserveNumberFormatting = False
            .AppendOnImport = False
        End With
        ActiveWorkbook.XmlImport URL:= _
            "http://republicavirtual.com.br/web_cep.php?cep=" & sCEP, ImportMap:= _
            Nothing, Overwrite:=False, Destination:=Range("Plan2!$a$1")
            
            
    End If
        
    Calculate
    
Sair:
    Exit Sub
TratarErro:
    MsgBox "CEP não cadastrado!"
    GoTo Sair
    Resume
End Sub

abx.

[rafaelsetti]

OBRIGADO PELA RESPOSTA, OS DADOS NÃO ESTÃO NA PLANILHA, ELE DIGITOU EM UM FORMULÁRIO TEXTCEP. AI QUERIA QUE PREENCHESSE OS CAMPOS TEXTN, TEXTENDERECO, COMBOCIDADE, E COMBOUF. ENTENDEU ???

OBRIGADO,

RAFAEL

[rafaelsetti]

OS CAMPOS ESTÃO EU UM FORM USERFORM1

[rafaelsetti]

basole, como faço para rodar esse código que você me passou ele dá erro quando eu aplico esse código diz que o código não foi cadastrado!!!

Obrigado,

Rafael

[Basole]

OS CAMPOS ESTÃO EU UM FORM USERFORM1

@Rafael Seria bom voce compartilhar um exemplo com o userform.

[rafaelsetti]

Este é o código de inclusão de cliente. Mas antes deste código preciso de um outro código de busca de endereço, numero, bairro, cidade, uf sem usar internet explorer, sendo o campo a informar o cep é o textcep.

Obrigado,

Rafael

Private Sub CommandINCLUIR_Click()

Dim BD As Database

Dim dt As Recordset

Dim CADASTRO(1 To 15)

CADASTRO(1) = UCase(Me.TextCLIENTE.Text)

CADASTRO(2) = UCase(Me.TextRG.Text)

CADASTRO(3) = UCase(Me.TextCPF.Text)

CADASTRO(4) = UCase(Me.TextDATA.Text)

CADASTRO(5) = UCase(Me.TextENDERECO.Text)

CADASTRO(5) = UCase(Me.TextENDERECO.Text)

CADASTRO(6) = UCase(Me.TextN.Text)

CADASTRO(7) = UCase(Me.TextBAIRRO.Text)

CADASTRO(8) = UCase(Me.ComboCIDADE.Text)

CADASTRO(9) = UCase(Me.ComboUF.Text)

CADASTRO(10) = UCase(Me.TextCEP.Text)

CADASTRO(11) = UCase(Me.TextTELRES.Text)

CADASTRO(12) = UCase(Me.TextTELCEL.Text)

CADASTRO(13) = UCase(Me.TextTELCOM.Text)

CADASTRO(14) = UCase(Me.TextRAMAL.Text)

CADASTRO(15) = LCase(Me.TextEMAIL.Text)

CADASTRO(16) = LCase(Me.textcompl.Text)

If Len(Me.TextCLIENTE) = 0 Then

MsgBox "VOCÊ NÃO DIGITOU NENHUM NOME PARA INCLUSÃO", vbCritical, "CADASTRO DE CLIENTES"

Else

Carrega_imagem_Click

Set BD = OpenDatabase("\\SERVIDOR\real feet\database\realfeet.mdb")

Set rs = BD.OpenRecordset("cliente")

If Me.Textcod.Text = "" Then

MsgBox "INSIRA UM CÓDIGO DE CLIENTE VÁLIDO"

Me.Textcod.SetFocus

Exit Sub

End If

' os campos na tabela já estão criados, DataNascimento e CodigoPostal

' falta somente os textboxes rerentes a eles e adicionar abaixo no código (rs.DastaNscimento e rs.CodigoPostal)

Call TiraAcento2(TextCLIENTE.Text)

While Not rs.EOF

'adicione os ítens a ser criados aqui!!!!!!!

If rs!codigo = Me.Textcod.Text Then

MsgBox ("CÓDIGO DE CLIENTE JÁ CADASTRADO")

resp = 1

GoTo FIM2

End If

If rs!NOME = Me.TextCLIENTE.Text Then

MsgBox ("NOME DE CLIENTE JÁ CADASTRADO")

resp = 1

GoTo FIM2

End If

rs.MoveNext

Wend

If resp <> 1 Then

rs.AddNew

rs!codigo = Me.Textcod.Text

rs!NOME = CADASTRO(1)

rs!RG = Me.TextRG

rs!CPF = Me.TextCPF

rs!DATANASCIMENTO = Me.TextDATA

rs!endereco = CADASTRO(5)

rs!N = Me.TextN

rs!COMPL = Me.textcompl

rs!BAIRRO = CADASTRO(7)

rs!CIDADE = CADASTRO(8)

rs!UF = CADASTRO(9)

rs!cep = Me.TextCEP

rs!FONE1 = Me.TextTELRES

rs!FONE2 = Me.TextTELCEL

rs!RAMAL = Me.TextRAMAL

rs!Email = CADASTRO(15)

rs!FOTO = Me.TextCAMINHOPATH

rs.Update

rs.Close

BD.Close

MsgBox ("DADOS INSERIDOS COM SUCESSO!"), vbInformation

Call TiraAcento(rs!NOME)

Me.Textcod = Null

Me.TextCLIENTE = Null

Me.TextRG = Null

Me.TextCPF = Null

Me.TextDATA = Null

Me.TextENDERECO = Null

Me.TextN = Null

Me.textcompl = Null

Me.TextBAIRRO = Null

Me.TextCEP = Null

Me.TextTELRES = Null

Me.TextTELCEL = Null

Me.TextRAMAL = Null

Me.TextEMAIL = Null

Me.ComboCIDADE = Null

Me.ComboUF = Null

Me.IMAGEFOTO.Picture = Nothing

Me.TextCAMINHOPATH = Null

Me.Textcod.SetFocus

FIM2:

End If

GoTo FIM

Exit Sub

FIM:

End If

End Sub

[Basole]

Olá Rafael boa noite,

Segue o link de exmplo do codigo que postei acima em um userform:

abx.

https://www.sendspace.com/file/p1alus