检查 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

而不是

oXMLHTTP.responseText

你可以使用

oXMLHTTP.Status = 200 

这里是 xmlHttp 的状态列表

https://docs.microsoft.com/en-us/previous-versions/windows/desktop/ms767625(v%3Dvs.85)

Answer 2

你可以通过在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