Проверьте действительные URL-адреса для Wistia

Question

Я нашел код, который я конвертирую в UDF, чтобы проверить, является ли URL-адрес wistia действительным или нет ..

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

Вы можете повысить эффективность, создав объект 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

---

Альтернативы:

В функциональном тесте на наличие идентификатора, который присутствует только в действительных ссылках, или строки (в том виде, как вы это сделали)

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

Answer 2

целое число

oXMLHTTP.responseText

, которое вы можете использовать

oXMLHTTP.Status = 200 

, вот список состояний для xmlHttp

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