• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Search "CEP" in web import to sheet

Code:
UF    Localidade    Result
AC    Acrelândia    69900-000 a 69999-999
AC    Assis Brasil    69935-000 a 69935-999
AC    Brasiléia    69900-000 a 69999-999
AC    Bujari    69926-000 a 69926-999
AC    Capixaba    69931-000 a 69931-999
AC    Cruzeiro do Sul    69980-000 a 69980-999
AC    Epitaciolândia    69900-000 a 69999-999
AC    Feijó    69900-000 a 69999-999
AC    Jordão    69900-000 a 69999-999

is that ??/
 
Code:
Sub gClick()
    Dim arr, UF As String, Localidade As String
    Dim intLoop, brr
    Dim xmlhttp, arrTemp
   
    If vbNo = MsgBox("It will take a lot of time ,continue ??", vbInformation + vbYesNo, "wudixin96") Then Exit Sub
    Set xmlhttp = CreateObject("msxml2.xmlhttp")
   
    arr = ThisWorkbook.Sheets("Plan1").[a1].CurrentRegion
    ReDim brr(1 To UBound(arr), 1 To 1)
    brr(1, 1) = "Result"
   
    For intLoop = 2 To UBound(arr)
        UF = arr(intLoop, 1)
        Localidade = arr(intLoop, 2)
        With xmlhttp
            .Open "post", "http://www.buscacep.correios.com.br/servicos/dnec/consultaFaixaCepAction.do", False
            .SetRequestHeader "Referer", "http://www.buscacep.correios.com.br/servicos/dnec/menuAction.do?Metodo=menuFaixaCep"
            .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
            .Send "UF=" & UF & "&Localidade=" & Localidade & "&cfm=1&Metodo=listaFaixaCEP&TipoConsulta=faixaCep&StartRow=1&EndRow=10"
            arrTemp = Split(.responsetext, "<td>")
           
            brr(intLoop, 1) = Application.Trim(Replace(Replace(Split(arrTemp(UBound(arrTemp)), "</td>")(0), "&nbsp;", ""), vbLf, ""))
        End With
        If intLoop Mod 10 = 0 Then [C1].Resize(UBound(brr), 1) = brr
    Next
   
    [C1].Resize(UBound(brr), 1) = brr
End Sub
 

Attachments

  • GetDataWEB.xlsm
    126.3 KB · Views: 1
hi wudi, i have new question.

Do you can (via VBA) get "Faixa" based image?

Thank you!
 

Attachments

  • RowBelowFaixa.jpg
    RowBelowFaixa.jpg
    109.6 KB · Views: 1
hi wudi, i have new question.

Do you can (via VBA) get "Faixa" based image?

Thank you!
i know where is wrong

if Localidade is English Letter,code return right
but if Localidade contains Non English Letters ,it will return 69900-000 a 69999-999
 
Code:
Sub gClick()
    Dim arr, UF As String, Localidade As String
    Dim intLoop, brr, sPost As String
    Dim xmlhttp, arrTemp
   
    If vbNo = MsgBox("It will take a lot of time ,continue ??", vbInformation + vbYesNo, "wudixin96") Then Exit Sub
    Set xmlhttp = CreateObject("winhttp.winhttprequest.5.1")
   
    arr = ThisWorkbook.Sheets("Plan1").[a1].CurrentRegion.Value
    ReDim brr(1 To UBound(arr), 1 To 1)
    brr(1, 1) = "Result"
   
    For intLoop = 2 To UBound(arr)
        UF = arr(intLoop, 1)
        Localidade = arr(intLoop, 2)
        Localidade = UrlEncode(Localidade)
        sPost = "UF=" & UF & "&Localidade=" & Localidade & "&cfm=1&Metodo=listaFaixaCEP&TipoConsulta=faixaCep&StartRow=1&EndRow=10"
       
        Debug.Print sPost
        With xmlhttp
            .Open "post", "http://www.buscacep.correios.com.br/servicos/dnec/consultaFaixaCepAction.do", False
            .SetRequestHeader "Referer", "http://www.buscacep.correios.com.br/servicos/dnec/menuAction.do?Metodo=menuFaixaCep"
            .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
            .SetRequestHeader "Content-Length", Len(sPost)
            .Send sPost

            arrTemp = Split(.responsetext, "<td>")
           
            brr(intLoop, 1) = Application.Trim(Replace(Replace(Split(arrTemp(UBound(arrTemp)), "</td>")(0), "&nbsp;", ""), vbLf, ""))
        End With
        If intLoop Mod 10 = 0 Then [C1].Resize(UBound(brr), 1) = brr
    Next
   
    [C1].Resize(UBound(brr), 1) = brr
End Sub

Function UrlEncode(ByVal aa As String)
    Dim x, s
    Set x = CreateObject("ScriptControl")
    x.Language = "JavaScript"
    s = "function j(s) { return escape(s); }"
    x.AddCode s
    UrlEncode = x.eval("j('" & aa & "')")
End Function

i think it works right now
Code:
UF    Localidade    Result
AC    Acrelândia    69945-000 a 69945-999
AC    Assis Brasil    69935-000 a 69935-999
AC    Brasiléia    69932-000 a 69932-999
AC    Bujari    69926-000 a 69926-999
 
Whay code bring this great string in cell?
<html><head><title>Access Denied</title><style type="text/css"><!--.container { background-color: #FFFFFF; border: 5px solid #999999; font-family:Tahoma,Helvetica,Arial,sans-serif; font-size:14px; margin: 20px; padding-top: 20px; padding-right: 45px; padding-bottom: 20px; padding-left: 45px;}body,td,th { color: #000000;}body { background-color: #5e6a71;}h1{ font-size:22px; font-weight:bold; color:#8a0e1f;}--></style></head><body><div class="container"><h1>Access Denied</h1>An access request has been blocked due to one of the following reasons:<ul> <li>You do not have sufficient privileges to access this destination</li> <li>Your corporate IT policies prohibit access to this content or application</li> <li>McAfee Global Threat Intelligence has determined</li> <ul> <li>this destination to have a suspicious or malicious reputation at this time </li> <li>something in the connection that matches a threat defense signature </li> <li>malware, spyware or other content should be blocked</li> </ul> </ul> <strong>Please contact your administrator if you feel this is incorrect. </strong></div></body></html>
 
Hi wudixin.

I can't fix it (still does't work in my computer), but i'm glad your help.

Thank you for spend your time to help me, thank you very much!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
Back
Top