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), " ", ""), 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