Question

我有一个域名列表，其中很多都将我重定向到同一个域名。例如...... foo1.com，foo2.csm和foo3.com都将我存放在foo.com。

我正在尝试通过编写VBA脚本来加载最终页面并提取它的URL来对域列表进行重复数据删除。

我从这篇文章开始检索页面的标题（http://www.excelforum.com/excel-programming-vba-macros/355192-can-i-import-raw-html-source-code-into-excel.html），但无法弄清楚如何修改它以获取最终的URL（我可以从中提取URL。

任何人都可以指出我正确的方向吗？

Answer 1

试试这个，需要看看.LocationURL：

Public Function gsGetFinalURL(rsURL As String) As String
Dim ie As Object

Set ie = CreateObject("InternetExplorer.Application")

With ie
    .navigate rsURL
    Do While .Busy And Not .ReadyState = 4
        DoEvents
    Loop
    gsGetFinalURL = .LocationURL
    .Quit
End With

Set ie = Nothing
End Function

我没有尝试过各种各样的网址，只是你提供的网址和其他网址。如果它是无效的URL，它将返回传递的内容。您可以使用原始函数中的代码进行相应的检查和处理。

Answer 2

添加对“Microsoft XML，v3.0”（或您拥有的任何版本）的引用

Sub tester()
    Debug.Print CheckRedirect("adhpn2.com")
End Sub

Function CheckRedirect(URL As String)
    If Not UCase(URL) Like "HTTP://*" Then URL = "http://" & URL
    With New msxml2.ServerXMLHTTP40
        .Open "HEAD", URL, False
        .send
        CheckRedirect = .getOption(-1)
    End With
End Function

从Excel VBA中爬网到最终到达网址

2 个答案: