excel - Excel VBA : get error code for invalid URL in hyperlink with WinHttpRequest

Question

在Excel中，我有一个带有URL的列表。我需要检查IE(默认浏览器)是否可以打开这些文件。他们不必实际打开，而是要检查可访问性。
如果他们无法打开，我需要隔离错误代码，并将其放在另一列中。

在这里搜索之后，我开始关注超链接，并使用GET来获取MsgBox中的数据。这似乎部分起作用，但是现在我当然可以将每个URL的MsgBox都正确无误了。我也在寻找一种提取错误并将其放置在 Activity 工作表中的方法。

到目前为止，我得到的是:

Sub Request_Data()

' declare
numRow = 2
Dim MyRequest As Object

' activate URLs without Follow
Do While ActiveSheet.Range("C" & numRow).Hyperlinks.Count > 0
numRow = numRow + 1

' create request
Set MyRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
MyRequest.Open "GET", _
ActiveSheet.Range("C" & numRow)

' send request
MyRequest.Send

' outcome
MsgBox MyRequest.ResponseText

' isolate the error code (for example 404)
' place error code in excel sheet in column H next to row URL
Loop

End Sub

有人知道我应该怎么做吗？
我认为这可能有用，但我不知道从哪里开始。
Checking for broken hyperlinks in Excel
和
Bulk Url checker macro excel

提前致谢

Answer 1

请参见下面的代码-您将需要修改Test子例程以遍历单元格，并为要测试的每个值调用IsValidUrl:

Option Explicit

Sub Test()
    MsgBox IsValidUrl("http://www.thisdoesnotexistxxxxxxxxxxxxx.com/")
    MsgBox IsValidUrl("http://www.google.com/")
    MsgBox IsValidUrl("http://www.ppppppppppppqqqqqqqqqqqqqqrrrrrrrrrrrrr.com/")
End Sub

Function IsValidUrl(strUrl As String) As Long

    Dim objRequest As Object
    Dim lngCode As Long

    On Error GoTo ErrHandler

    Set objRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
    With objRequest
        .Open "GET", strUrl
        .Send
        lngCode = 0
    End With

    GoTo ExitHandler

ErrHandler:
    lngCode = Err.Number

ExitHandler:
    Set objRequest = Nothing
    IsValidUrl = lngCode

End Function

我的输出是:

-2147012889 
 0 
-2147012889