超链接打开时会更改地址

Question

Excel 数据中的超链接： HTTPS://apply.d.co.uk/JobDetail/9467 但是当我点击它时，地址是： HTTPS://apply.d.co.uk/错误

我尝试检查 URL 是否正确，它总是说是，但当我打开它时，它会发生变化并显示地址错误。

我使用的功能：

Function URLExists(url As String) As Boolean
    Dim Request As Object
    Dim ff As Integer
    Dim rc As Variant

    On Error GoTo EndNow
    Set Request = CreateObject("WinHttp.WinHttpRequest.5.1")

    With Request
      .Open "GET", url, False
      .Send
      rc = .StatusText
    End With
    Set Request = Nothing
    If rc = "OK" Then URLExists = True

    Exit Function
EndNow:
End Function

我只需要一个解决方案，这样我就不需要打开每个超链接来检查它是否显示错误。

Answer 1

CheckConn

返回 http 状态代码。如果 url 不可访问，则返回 0。

https://developer.mozilla.org/en-US/docs/Web/HTTP/Status

Option Explicit

Public Function CheckConn(sURL) As Integer
    Const WHR_EnableRedirects = 6
    Dim oXmlHttp As Object, nRetVal As Integer
    On Error Resume Next
    Set oXmlHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    oXmlHttp.Option(WHR_EnableRedirects) = True
    oXmlHttp.Open "HEAD", sURL, False
    oXmlHttp.setRequestHeader "Content-Type", "text/xml"
    oXmlHttp.send ""
    nRetVal = oXmlHttp.Status
    Set oXmlHttp = Nothing
    CheckConn = nRetVal
    On Error GoTo 0
End Function
Sub demo()
    Dim sU As String
    sU = "HTTPS://apply.d.co.uk/JobDetail/9467"
    Debug.Print (CheckConn(sU))
    sU = "https://www.google.com/"
    Debug.Print (CheckConn(sU))
End Sub