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

Answer 1

testing这个：

 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 

这里是如何testing一个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 

Answer 2

而不是xmlhttp数据types使用对象。 使用下面的代码。 。 您需要input“ 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