Como substituir a automação do Internet Explorer (IE) por MSXML2.ServerXMLHTTP em VBA para consulta de CEPs?

Esta resposta foi traduzida automaticamente e pode conter pequenos erros gramaticais ou formulações incomuns. Agradecemos a sua compreensão.

Olá @Evander Blackwood

Sim, é possível substituir o InternetExplorer.Application por uma requisição HTTP direta. O MSXML2.ServerXMLHTTP.6.0 suporta o padrão usual — Open, setRequestHeader, send, Status e responseText —, dispensando, portanto, a automação de um navegador ou do DOM HTML.

O exemplo abaixo utiliza uma resposta em formato JSON, no estilo do serviço ViaCEP. O serviço espera um CEP de oito dígitos e retorna campos como logradouro, bairro, localidade e uf. Um formato inválido resulta em um erro HTTP 400, enquanto um CEP válido, porém inexistente, retorna "erro": true.

Primeiro, importe o módulo JsonConverter.bas do VBA-JSON. Seu método ParseJson converte objetos JSON em dicionários VBA e arrays em coleções.

Option Explicit
Public Function ConsultarCEP(ByVal CEP As String) As Object
    Dim http As Object
    Dim json As Object
    Dim url As String
    On Error GoTo TrataErro
    'Remove common punctuation and spaces
    CEP = Replace(CEP, "-", "")
    CEP = Replace(CEP, " ", "")
    CEP = Trim$(CEP)
    'Validate the CEP before sending the request
    If Len(CEP) <> 8 Or Not IsNumeric(CEP) Then
        Err.Raise vbObjectError + 1000, , _
                  "The CEP must contain exactly eight digits."
    End If
    url = "https://viacep.com.br/ws/" & CEP & "/json/"
    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    With http
        .Open "GET", url, False
        .setRequestHeader "Accept", "application/json"
        .setTimeouts 5000, 5000, 10000, 10000
        .send
        If .Status <> 200 Then
            Err.Raise vbObjectError + 1001, , _
                      "HTTP error " & .Status & ": " & .statusText
        End If
        Set json = JsonConverter.ParseJson(.responseText)
    End With
    If json.Exists("erro") Then
        If json("erro") = True Then
            Err.Raise vbObjectError + 1002, , "CEP not found."
        End If
    End If
    Set ConsultarCEP = json
    Exit Function
TrataErro:
    Set ConsultarCEP = Nothing
    MsgBox Err.Description, vbExclamation, "CEP lookup"
End Function

Exemplo de preenchimento de células de uma planilha:

Public Sub PreencherEndereco()
    Dim endereco As Object
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set endereco = ConsultarCEP(CStr(ws.Range("A2").Value))
    If endereco Is Nothing Then Exit Sub
    ws.Range("B2").Value = endereco("logradouro")
    ws.Range("C2").Value = endereco("bairro")
    ws.Range("D2").Value = endereco("localidade")
    ws.Range("E2").Value = endereco("uf")
End Sub

Isso utiliza late binding (vinculação tardia), portanto, não é necessária uma referência à biblioteca "Microsoft XML, v6.0". Se preferir utilizar early binding (vinculação antecipada), ative essa referência em "Ferramentas" > "Referências" (Tools > References) e declare a requisição como MSXML2.ServerXMLHTTP60.

Para processamento em lote, chame a função uma vez para cada CEP distinto, armazene os resultados obtidos anteriormente em um objeto Scripting.Dictionary e evite realizar consultas repetidas para o mesmo CEP. Além disso, verifique as condições de uso da API escolhida antes de processar uma lista extensa.

A principal mudança é que a macro agora consome a resposta estruturada da API diretamente, em vez de abrir um navegador e pesquisar na página por meio de IE.document.getElementById.

Espero que isso ajude; sinta-se à vontade para entrar em contato caso precise de mais alguma assistência.