Este fórum está sendo desativado

[daviiiiii]

Pessoal, bom dia!

Poderiam me ajudar?

Estou utilizando o codigo abaixo para valiar alguns links, porem não sei com fazer para que o comando se repita para as linhas abaixo. até 15.000 linhas.

Código: Selecionar todos

Sub caça_link()


Set ie = CreateObject("internetexplorer.application")


ie.navigate Range("B2")
Do While ie.busy And ie.readyState <> "READYSTATE_COMPLETE"
DoEvents
Loop
Range("C2") = ie.document.getElementsByTagName("head")(0).innertext


ie.Quit

End Sub

[osvaldomp]

Olá, @daviiiiii .

Experimente o código abaixo. Funciona para qualquer quantidade de URLs listadas na coluna B a partir de B2.

Código: Selecionar todos

Sub caça_linkV2()
 Dim ie As Object, c As Range
  For Each c In Range("B2:B" & Cells(Rows.Count, 2).End(3).Row)
   Set ie = CreateObject("internetexplorer.application")
   ie.navigate c.Value
   Do While ie.Busy And ie.readyState <> "READYSTATE_COMPLETE"
    DoEvents
   Loop
   c.Offset(, 1).Value = ie.document.getElementsByTagName("head")(0).innertext
  Next c
  ie.Quit
End Sub

[daviiiiii]

Olá amigo, obrigado pela ajuda.

Funcionou de forma parcial, ao trazer a quinta reposta a macro erro.

[osvaldomp]

Exclua a tal "quinta URL" e rode o código novamente. Se alguma outra URL apresentar erro repita a operação. Depois salve uma planilha com algumas (somente algumas, não as 15.000, please) URLs que apresentaram resultado correto e algumas que resultaram erro. Destaque as que apresentarem erro.

[daviiiiii]

Osvaldo, boa tarde amigo!

Estou encaminhando o arquivo para sua análise, se possível claro!

Pois, o erro acontece em linhas diferentes.

[osvaldomp]

Olá, @daviiiiii .

Experimente este código abaixo. Aqui roda em torno de 2 min para executar as 399 URLs.

Código: Selecionar todos

Sub caça_linkV3()
 Dim ie As Object, c As Range
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Set ie = CreateObject("internetexplorer.application")
  For Each c In Range("B2:B" & Cells(Rows.Count, 2).End(3).Row)
   ie.navigate c.Value
   While ie.Busy Or ie.ReadyState <> 4: DoEvents: Wend
   c.Offset(, 1).Value = ie.document.getElementsByTagName("head")(0).innertext
  Next c
  ie.Quit
  Application.Calculation = xlCalculationAutomatic
End Sub

[daviiiiii]

Osvaldo, bom dia!

Deu certo!! Muito obrigado.