Vou enviar a noite para um servidor de compartilhamento

 

 

eu uso este, esta dica é do vbmania

 

Private Sub comBusca_Click()
On Error GoTo Trata_Erro

'------------------------------------------------------------------------
    If Len(txtCep.Value) <> 8 Then
        MsgBox "Digite o CEP com 8 Digitos e apenas Numeros", vbExclamation, "Localizar CEP ON-Line"
        txtCep.SetFocus
    Exit Sub
    End If
'------------------------------------------------------------------------
    ''BtCep.Caption = "Aguarde..."
    MousePointer = vbHourglass
    ''LblStatusCEP(0).Visible = True
    ''LblStatusCEP(1).Visible = True
'------------------------------------------------------------------------
    Dim Xlink As String
    Set myXML = New DOMDocument
'-------------------------------------------------------------
    myXML.resolveExternals = True
    myXML.validateOnParse = True
    myXML.async = False
'-------------------------------------------------------------
    Xlink = "http://cep.republicavirtual.com.br/web_cep.php?cep=" & txtCep.Text & "&formato=xml"
    myXML.Load (Xlink)
'-------------------------------------------------------------
    For Each XCep In myXML.documentElement.childNodes
'------------------------------------------------------------------------
        Select Case XCep.nodeName
       
                    Dim XRua As String
                    Dim XTipo As String
              
               Case Is = "logradouro"
                    XRua = UCase$(XCep.childNodes(0).Text)
               Case Is = "uf"
                    ''TxtEstado.Text = UCase$(XCep.childNodes(0).Text)
               Case Is = "cidade"
                    txtMun.Text = UCase$(XCep.childNodes(0).Text)
               Case Is = "bairro"
                    txtBai.Text = UCase$(XCep.childNodes(0).Text)
               Case Is = "tipo_logradouro"
                    XTipo = UCase$(XCep.childNodes(0).Text)
               Case Is = "resultado_txt"
                    ''LblStatusCEP(1).Caption = UCase$(XCep.childNodes(0).Text)
'------------------------------------------------------------------------
                ''If LblStatusCEP(1).Caption <> "SUCESSO - CEP COMPLETO" Then
                ''    txtCep.ForeColor = vbRed
                ''    txtCep.SetFocus
                ''        Else
                ''    LblStatusCEP(1).ForeColor = vbBlack
                ''    txtCep.ForeColor = vbBlack
                ''End If
'------------------------------------------------------------------------
        End Select
    Next
    '------------------------------------------------------------------------
        txtEnd.Text = XTipo & " " & XRua 'PREENCHE O LOGRADOURO
    '------------------------------------------------------------------------
        MousePointer = vbDefault
        ''BtCep.Caption = "Iniciar Cosulta"
    '------------------------------------------------------------------------
Exit Sub

Trata_Erro:

    MousePointer = vbDefault
    ''BtCep.Caption = "Iniciar Cosulta"

MsgBox "Ocorreu um Erro ao tentar localizar este CEP" & vbCrLf & _
"Verifique se existe Conexao com a Internet e tente novamente" & vbCrLf & vbCrLf & _
Err.Number & " - " & Err.Description & " - " & Err.Source, vbExclamation, "ERRO - Localizar CEP ON-Line"

'------------------------------------------------------------------------
    ''LblStatusCEP(1).ForeColor = vbRed
    txtCep.SelStart = 0
    txtCep.SelLength = Len(txtCep.Text)
'------------------------------------------------------------------------

End Sub