粘贴从网页上删除的URL

Question

所以我希望将一堆网页从网页转储到excel作为列表。我之前将这些项目转储到列表框中，但我发现列表框很难处理！

一旦我将URL收集到excel中的列中，我希望excel单击每个链接并找到页面上的电子邮件地址。这是我目前的编码......

Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True

url_name = Sheet1.Range("A2")
If url_name = "" Then Exit Sub

IE.Navigate (url_name)

Do
DoEvents
Loop Until IE.ReadyState = 4

Set AllHyperLinks = IE.Document.GetElementsByTagName("A")

For Each hyper_link In AllHyperLinks

Range("x":"F").Value = hyper_link

这就是我到目前为止所有的一切！我不知道如何完成循环！我希望代码在页面F的下一个空行中粘贴它在页面上找到的每个新URL。

Answer 1

您可以这样完成循环：

Dim IE As Object, LR As Long, i As Long
LR = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
For i = 2 To LR
url_name = Sheet1.Range("A" & i).Value
If url_name = "" Then Exit Sub

IE.Navigate (url_name)

Do
DoEvents
Loop Until IE.ReadyState = 4

Set AllHyperLinks = IE.Document.GetElementsByTagName("A")

For Each hyper_link In AllHyperLinks

Range("x":"F").Value = hyper_link

Next hyper_link
Next i

请注意，如果您拥有大量数据，则需要花费LOOOONGGGG时间。