我对 EXCEL VBA 很陌生,我有点困于寻找一种方法来创建一个宏来显示 url 是否仍然处于活动状态(200 ok),
或者可能会被重定向,如果是这样,我想知道到什么 URL。当它根本不起作用时,则返回正确的代码以及 URL 不起作用的原因。
因此,目前我有一个实际有效的脚本,但它不会返回 url 重定向到的 url。
仅当 url 仍处于活动状态或原始 url 已重定向到的 url 仍处于活动状态时,它才会返回 (200 OK)。这样我就知道哪些 URL 无效或被重定向到无效 URL。
但我想更进一步。
由于我现在要检查的 URL 在“A”列中,而结果在“B”列中返回,因此每次我都想在 C 列中看到我被重定向到的 URL URL 已重定向。
我确实在网上找到了一些可以完成这项工作的函数,但由于某种原因我无法将它们放入我的 SUB 中。就像我之前提到的,这对我来说都是新的。
这就是我现在所拥有的:
Sub CheckHyperlinks()
Dim oColumn As Range
Set oColumn = GetColumn() '' replace this with code to get the relevant column
Dim oCell As Range
For Each oCell In oColumn.Cells
If oCell.Hyperlinks.Count > 0 Then
Dim oHyperlink As Hyperlink
Set oHyperlink = oCell.Hyperlinks(1) '' I assume only 1 hyperlink per cell
Dim strResult As String
strResult = GetResult(oHyperlink.Address)
oCell.Offset(0, 1).Value = strResult
End If
Next oCell
End Sub
Private Function GetResult(ByVal strUrl As String) As String
On Error GoTo ErrorHandler
Dim oHttp As New MSXML2.ServerXMLHTTP30
oHttp.Open "HEAD", strUrl, False
oHttp.send
GetResult = oHttp.Status & " " & oHttp.statusText
Exit Function
ErrorHandler:
GetResult = "Error: " & Err.Description
End Function
我希望你们中的一位可以帮助我。
最好使用 WinHttp COM 对象。这将使您“禁用”重定向处理。阅读此论坛帖子。
您需要引用的组件是微软WinHTTP服务.
![Microsoft WinHTTP Services](https://i.stack.imgur.com/bLUHR.png)
Public Function GetResult(ByVal strUrl As String, Optional ByRef isRedirect As Boolean, Optional ByRef target As String) As String
Dim oHttp As New WinHttp.WinHttpRequest
oHttp.Option(WinHttpRequestOption_EnableRedirects) = False
oHttp.Open "HEAD", strUrl, False
oHttp.send
GetResult = oHttp.Status & " " & oHttp.statusText
If oHttp.Status = 301 Or oHttp.Status = 302 Then
isRedirect = True
target = oHttp.getResponseHeader("Location")
Else
isRedirect = False
target = Nothing
End If
End Function
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)