Excel Implementar rastreador dos correios no excel

[AdolffGustavo]

Boa tarde pessoal.

Eu trabalho com um pipeline na minha instituição onde realizo a gestão dos contratos e negócios da minha carteira de clientes. Frequentemente eu utilizo o rastreamento no site dos correios para conferir correspondencias que solicitamos para os clientes.

Estou pesquisando como anexar um rastreador direto no meu pipeline.

 

Cheguei a este código:
 

Sub RastreamentoCorreios()

Set IE = CreateObject("internetexplorer.application")
IE.Visible = False
IE.Navigate "https://www2.correios.com.br/sistemas/rastreamento/default.cfm"
Do While IE.Busy Or IE.ReadyState <> 4: Loop

IE.Document.getElementByID("objetos").innerText = "PM439050030BR"
IE.Document.getElementByID("btnPesq").Click
Do While IE.Busy Or IE.ReadyState <> 4: Loop

For Each elementoTabela In IE.Document.getElementsByClassName("listEvent sro")
Debug.Print elementoTabela.innerText
Next

IE.Quit

End Sub

 

O que eu interpretei é que ele apenas captura dentro do Visual Basic e apresenta o rastreamento da linha na caixa de Verificação Imediata.

Como transcrever o resultado da verificação imediata para as células da minha planilha? E outra dúvida é: queria deixar apenas o rastreio mais recente?
Gostaria que no pipeline eu chegase a este resultado: colocar o código de rastreio no campo, clicar no "botão" Rastreamento e ele me entregase o rastreio na celula seguinte.



alguém poderia me ajudar? Parece não ser algo complexo mas estou com dificuldades.

[Basole]

Veja nas alterações se é isso que precisa.

 

Insira o codigo de rastreamento na celula A2 e execute a macro

 

 

 

Sub RastreamentoCorreios()

Set IE = CreateObject("internetexplorer.application")
  IE.Visible = False
  IE.Navigate "https://www2.correios.com.br/sistemas/rastreamento/default.cfm"
  Do While IE.Busy Or IE.ReadyState <> 4: Loop
'                                      Codigo Rastreamento na A1
    With ActiveSheet
    IE.Document.getElementByID("objetos").innerText = VBA.Trim(.Range("A2").Value2)
    IE.Document.getElementByID("btnPesq").Click
        Do While IE.Busy Or IE.ReadyState <> 4: Loop
        
        For Each elementoTabela In IE.Document.getElementsByClassName("listEvent sro")
        
        .Cells(Cells(Rows.Count, 2).End(xlUp).Offset(1).Row, 2) = _
                  VBA.Replace(elementoTabela.innerText, VBA.Chr$(10), "")
         Exit For
         
        Next
    
    End With

IE.Quit

End Sub

 

[AdolffGustavo]

@Basole Agradeço o retorno mestre, muito obrigado. Agora que consegui resolver a questão do rastreio, estou com uma nova questão:

 

Quando eu coloco o CNPJ na "A2" ele busca na macro a Razão Social e replica na "B2".

 

Sub CNPJ()

Set p = ThisWorkbook.Worksheets("Pipeline - Empresas")
Set c = ThisWorkbook.Worksheets("CNPJ")

'Inicializa o site de busca
Set IE = CreateObject("internetexplorer.application")
IE.Visible = False
IE.Navigate "https://cnpj.biz"
Do While IE.Busy Or IE.ReadyState <> 4:
Loop

'Insere o valor na célula referente ao CNPJ
linha = 7: coluna = 2
For Each el In IE.Document.getElementsByClassName("smooth search")
    el.Value = p.Cells(linha, coluna)
        Exit For
Next
Do While IE.Busy Or IE.ReadyState <> 4:
Loop

IE.Document.getElementsByClassName("btn btn-b btn-sm")(0).Click

Do While IE.Busy Or IE.ReadyState <> 4:
Loop

'Pesquisa a razão social
linha = 1: coluna = 1
For Each elementoTabela In IE.Document.getElementsByClassName("post-item")
c.Cells(linha, coluna) = elementoTabela.innerText

Next

End Sub

 

Neste caso eu criei uma nova planilha chamada de CNPJ, que recebe os valores buscados do site e a minha planilha principal só espelha de maneira formatada a informação.

 

Adicionei o seguinte código a planilha principal:

 

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = Range("A1").Address Then

Call CNPJ

End If

End Sub

 

Ele chama a macro de pesquisa quando eu insiro o CNPJ na célula A1 e me da o resultado na A2.

O que eu preciso é colocar um range em várias células para que elas vão fazendo a pesquisa de forma automatizada porém quando eu coloco Range("A1:A10") por exemplo, ele não ativa as funções.