URL检查VBA错误

时间:2015-11-26 13:33:28

标签: excel vba excel-vba

我的代码如下。我收到错误

  

"运行时错误' -2146697211 * 800c0005)'':系统找不到指定的资源"

我不知道如何解决它,提前感谢任何帮助。处理错误的行是httpRequest.send

Function pullSomeSite(urlcheck As String) As Boolean

Dim httpRequest As xmlhttp
Set httpRequest = New xmlhttp
Dim URL As String

URL = urlcheck
With httpRequest
    .Open "POST", URL, False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .send !!!!!!here code stops!!!!!!!
End With
With httpRequest

    While Not .readyState = 4                               '<---------- wait
        Application.Wait Now + TimeValue("0:00:01")
    Wend

    'Debug.Print .Status

    If .Status = 200 Then
        While InStr(1, .responseText, "Updating", 0) > 0    '<---------- wait again
            Application.Wait Now + TimeValue("0:00:01")
        Wend
        pullSomeSite = True
     Else
     pullSomeSite = False

    End If
End With
End Function

2 个答案:

答案 0 :(得分:0)

测试一下:

Sub Test_URLExists()
  Dim url As String

  url = "http://stackoverflow.com/questions/33940044/url-check-in-vba-error"
  MsgBox url, vbInformation, URLExists(url)

  url = "http://stackoverflow.com/questions/12345678/url-check-in-vba-error"
  MsgBox url, vbInformation, URLExists(url)
End Sub

以下是如何使用函数测试URL:

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

    URLExists = False
    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

答案 1 :(得分:0)

而不是xmlhttp数据类型使用对象。 使用以下代码。 。您需要输入“http://google.com

Sub test1()
a = pullSomeSite("http://www.flipkart.com")


MsgBox a
End Sub


Function pullSomeSite(urlcheck As String) As Boolean

Dim httpRequest As Object

 Set httpRequest = CreateObject("MSXML2.XMLHTTP")
'Set httpRequest = New xmlhttp
Dim URL As String

URL = urlcheck
With httpRequest
    .Open "POST", URL, False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .send '!!!!!!here code stops!!!!!!!
End With
With httpRequest

    While Not .readyState = 4                               '<---------- wait
        Application.Wait Now + TimeValue("0:00:01")
    Wend

    'Debug.Print .Status

    If .Status = 200 Then
        While InStr(1, .responseText, "Updating", 0) > 0    '<---------- wait again
            Application.Wait Now + TimeValue("0:00:01")
        Wend
        pullSomeSite = True
     Else
     pullSomeSite = False

    End If
End With

End Function