Excel Como buscar vários Cep do site na planilha VBA

[Felipe Ricardo Dias Flores]

Bom Dia

 

Gostaria de tirar uma duvida em VBA, eu tenho uma planilha com vários cep, preciso buscar os dados dos Cep no site dos correios e retorna na coluna ao lado as informações, sucessivamente.

Fiz um código para tal, porém estou com dificuldade para pular para o próximo cep e fazer a busca.

Alguém pode me ajudar segue abaixo o código.

 

Sub busca_cep()
    Range("B3:D3").ClearContents
    
    
    Range("A3").Activate
    Do Until ActiveCell.Value = ""
    
    Set ie = CreateObject("internetexplorer.application")
    
    ie.navigate "http://www.buscacep.correios.com.br/sistemas/buscacep/"
    ie.Visible = True
    
    Do While ie.busy And ie.readyState <> "READYSTATE_COMPLETE"
    DoEvents
    Loop
    
           
    ie.document.getElementsByTagName("input")(0).Value = Cells(3, 1).Value
    ie.document.getElementsByClassName("btn2 float-right")(0).Click
    

    Do While ie.busy And ie.readyState <> "READYSTATE_COMPLETE"
    DoEvents
    Loop
    
    ActiveCell.Offset(0, 1).Value = ie.document.getElementsByTagName("td")(0).innertext
    ActiveCell.Offset(0, 2).Value = ie.document.getElementsByTagName("td")(1).innertext
    ActiveCell.Offset(0, 3).Value = ie.document.getElementsByTagName("td")(2).innertext
    ActiveCell.Offset(1, 0).Select
    ie.Quit
    Loop
    
    
    
    Range("A3:D3").WrapText = False
    
    
End Sub

 

[Visitante]

substitua esta linha

Range("B3:D3").ClearContents

 

por esta

Range("B3:D100").ClearContents

_______________________________________________________________________

 

substitua esta linha

ie.document.getElementsByTagName("input")(0).Value = Cells(3, 1).Value

 

por esta

ie.document.getElementsByTagName("input")(0).Value = Cells(ActiveCell.Row, 1)

 

________________________________________________________________________

 

substitua esta linha

Range("A3:D3").WrapText = False

 

por esta

Range("A3:D100").WrapText = False

[Felipe Ricardo Dias Flores]

Obrigado pela dica.

 

Funcionou legal porém se tem muitas linhas está gerando um erro que segue no anexo.

[Visitante]

Disponibilize o seu arquivo na forma que apresentou o erro. Imagens não servem.

[Felipe Ricardo Dias Flores]

Então está mostrando um erro 91no trecho do código abaixo.

ie.document.getElementsByTagName("input")(0).Value = Cells(ActiveCell.Row, 1)

 

 

A mensagem que mostra é: "Erro em tempo de execução '91':  A variável do objeto ou a variável do bloco 'With' não foi definida.

 

Segue o código completo:

 

 

Sub busca_cep()
    Range("B3:D1000").ClearContents
    
    
    Range("A3").Activate
    Do Until ActiveCell.Value = ""
    
    Set ie = CreateObject("internetexplorer.application")
    
    ie.navigate "http://www.buscacep.correios.com.br/sistemas/buscacep/"
    ie.Visible = True
    
    Do While ie.busy And ie.readyState <> "READYSTATE_COMPLETE"
    DoEvents
    Loop
    
           
    ie.document.getElementsByTagName("input")(0).Value = Cells(ActiveCell.Row, 1)
    ie.document.getElementsByClassName("btn2 float-right")(0).Click
    

    Do While ie.busy And ie.readyState <> "READYSTATE_COMPLETE"
    DoEvents
    Loop
    
    ActiveCell.Offset(0, 1).Value = ie.document.getElementsByTagName("td")(0).innertext
    ActiveCell.Offset(0, 2).Value = ie.document.getElementsByTagName("td")(1).innertext
    ActiveCell.Offset(0, 3).Value = ie.document.getElementsByTagName("td")(2).innertext
    ActiveCell.Offset(1, 0).Select
    ie.Quit
    Loop
    
    
    
    Range("A3:D1000").WrapText = False
    
    
End Sub

 

[Visitante]

15 horas atrás, osvaldomp disse:

Disponibilize o seu arquivo na forma que apresentou o erro.

 

Ao sugerir para você disponibilizar o seu arquivo eu quis dizer que é para você disponibilizar o seu arquivo e não somente o código.

 

Precisamos ver o arquivo com alguns exemplos de CEPs (3 ou 4 são suficientes) e com o código instalado, tudo na forma exata que apresentou o problema relatado por você.

[Midori]

@Felipe Ricardo Dias Flores Tente desta forma,

 

Sub busca_cep()
    Dim Linha   As Long
        
    Range("B:D").ClearContents
    
    Linha = 3
    
    Do Until Cells(Linha, 1) = ""
    
    Set ie = CreateObject("internetexplorer.application")
    
    ie.navigate "http://www.buscacep.correios.com.br/sistemas/buscacep/"
    ie.Visible = True
    
    Do While ie.busy And ie.readyState <> "READYSTATE_COMPLETE"
    DoEvents
    Loop
    
           
    ie.document.getElementsByTagName("input")(0).Value = Cells(Linha, 1).Value
    ie.document.getElementsByClassName("btn2 float-right")(0).Click
    

    Do While ie.busy And ie.readyState <> "READYSTATE_COMPLETE"
    DoEvents
    Loop
    
    Cells(Linha, 2) = ie.document.getElementsByTagName("td")(0).innertext
    Cells(Linha, 3) = ie.document.getElementsByTagName("td")(1).innertext
    Cells(Linha, 4) = ie.document.getElementsByTagName("td")(2).innertext
    Linha = Linha + 1
    ie.Quit
    Loop
    
    Range("B:D").WrapText = False
End Sub