excel - 检查 Wistia 的有效 URL

Question

我找到了一个代码，我将其转换为 UDF 以检查 wistia 的 url 是否有效..

Sub Test()
MsgBox CheckValidURL("https://fast.wistia.net/embed/iframe/vud7ff4i6w")
End Sub

Function CheckValidURL(sURL As String) As Boolean
Dim oXMLHTTP        As Object
Dim sResponseText   As String
Dim aScriptParts    As Variant

Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
oXMLHTTP.Open "GET", sURL, False
oXMLHTTP.Send

sResponseText = oXMLHTTP.responseText
aScriptParts = Split(sResponseText, "<script", , vbTextCompare)
If UBound(aScriptParts) > 0 Then CheckValidURL = True
End Function

我用几个链接测试了 UDF，我得到了正确的结果，但我不确定 UDF 是否正确
你能给我建议或改进那个UDF吗？
感谢先进的帮助

Answer 1

您可以通过在 sub 中创建 xhr 对象并传递给函数来提高效率，然后只查看响应头 link区分

Option Explicit
Public Sub Test()
    Dim urls(), i As Long, xhr As Object
    Set xhr = CreateObject("MSXML2.XMLHTTP")
    urls = Array("https://fast.wistia.net/embed/iframe/vud7ff4i6wyh", "https://fast.wistia.net/embed/iframe/vud7ff4i6w")
    For i = LBound(urls) To UBound(urls)
        MsgBox CheckValidURL(urls(i), xhr)
    Next
End Sub

Public Function CheckValidURL(ByVal url As String, ByVal xhr As Object) As Boolean
    With xhr
        .Open "GET", url, False
        .send
        CheckValidURL = Not .getResponseHeader("link") = vbNullString
    End With
End Function

替代方案:

在功能测试中是否存在仅在有效链接中的 id 或字符串(以您的方式)

Public Sub Test()
    Dim urls(), i As Long, html As HTMLDocument, xhr As Object
    Set xhr = CreateObject("MSXML2.XMLHTTP"): Set html = New HTMLDocument
    urls = Array("https://fast.wistia.net/embed/iframe/vud7ff4i6wyh", "https://fast.wistia.net/embed/iframe/vud7ff4i6w")
    For i = LBound(urls) To UBound(urls)
        MsgBox CheckValidURL(urls(i), xhr, html)
    Next
End Sub

Public Function CheckValidURL(ByVal sURL As String, ByVal xhr As Object, ByVal html As HTMLDocument) As Boolean
    With xhr
        .Open "GET", sURL, False
        .send
        html.body.innerHTML = .responseText
    End With
    CheckValidURL = html.querySelectorAll("#wistia_video").Length > 0
End Function

也使用 Instr 作品

Option Explicit
Public Sub Test()
    Dim urls(), i As Long, html As HTMLDocument, xhr As Object
    Set xhr = CreateObject("MSXML2.XMLHTTP")
    urls = Array("https://fast.wistia.net/embed/iframe/vud7ff4i6wyh", "https://fast.wistia.net/embed/iframe/vud7ff4i6w")
    For i = LBound(urls) To UBound(urls)
        MsgBox CheckValidURL(urls(i), xhr)
    Next
End Sub

Public Function CheckValidURL(ByVal sURL As String, ByVal xhr As Object) As Boolean
    With xhr
        .Open "GET", sURL, False
        .send
        CheckValidURL = InStr(.responseText, "html") > 0
    End With     
End Function

重写你的:

Option Explicit
Public Sub Test()
    Dim urls(), i As Long, html As HTMLDocument, xhr As Object
    Set xhr = CreateObject("MSXML2.XMLHTTP")
    urls = Array("https://fast.wistia.net/embed/iframe/vud7ff4i6wyh", "https://fast.wistia.net/embed/iframe/vud7ff4i6w")
    For i = LBound(urls) To UBound(urls)
        MsgBox CheckValidURL(urls(i), xhr)
    Next
End Sub

Public Function CheckValidURL(ByVal sURL As String, ByVal xhr As Object) As Boolean
    With xhr
        .Open "GET", sURL, False
        .send
        CheckValidURL = UBound(Split(.responseText, "<script", , vbTextCompare)) > 0
    End With
End Function