VBA检查URL的状态 [英] VBA to check the status of URL

问题描述

我创建了一个宏，我可以从任何网页中获取每个网址。

I have created the macro, in which I can fetch the each URL from any of webpage.

现在，我在列中都有每个网址。

Now, I have each URL in column.

任何人都可以帮助编写宏来检查这个URL是否正常工作。
如果这个URL中的任何一个不起作用，那么我应该错误地在下一列的URL旁边工作。

Can any one please help to write macro to check if this URL is working or not. If any one of this URL is not working then It should me error not working in next to URL in next column.

下面是我写的代码但似乎这不起作用：

Below is the code which i wrote however it seems this is not working:

Sub CommandButton1_Click()
Dim ie As Object
Dim html As Object
Dim j As Integer
j = 1
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
url = "www.mini.co.uk"
ie.navigate url
Do While ie.READYSTATE <> READYSTATE_COMPLETE
Application.StatusBar = "Trying to go to website ..."
Loop
Application.StatusBar = " "
Set html = ie.document
'Dim htmltext As Collection
Dim htmlElements As Object
Dim htmlElement As Object
Set htmlElements = html.getElementsByTagName("*")
For Each htmlElement In htmlElements
    'If htmlElement.getAttribute("href") <> "" Then Debug.Print htmlElement.getAttribute("href")
    If htmlElement.getAttribute("href") <> "" Then Cells(j, 1).Value = htmlElement.getAttribute("href")
    j = j + 1
Next

    ActiveSheet.Range("$A$1:$A$2752").removeDuplicates Columns:=1, Header:=xlNo

End Sub

此代码用于从网页获取网址。

This Code is to fetch the URL from webpage.

在我尝试检查网址是否正常的代码下方。

Below the code I am trying for to check the status of URL if its working or not.

Sub CommandButton2_Click()
Dim k As Integer
Dim j As Integer
k = 1
j = 1
'Dim Value As Object
'Dim urls As Object
'urls.Value = Cells(j, 1)
For Each url In Cells(j, 1)
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = False
url = Cells(j, 1)
ie.navigate url
Do While ie.READYSTATE <> READYSTATE_COMPLETE
Application.StatusBar = "checking the Data. Please wait..."
Loop
Cells(k, 2).Value = "OK"
'Set html = ie.document
ie.Quit
j = j + 1
k = k + 1
Next
End Sub

但是这段代码不起作用，请告诉我更改。

However this code is not working, please suggest me the changes.

问候，
Mayur Alaspure

Regards, Mayur Alaspure

推荐答案

由于您有兴趣知道该链接是否有效，xmlhttp可能是一个解决方案。

Since you are interested to know whether the link is working, xmlhttp may be one solution.

Set sh = ThisWorkBook.Sheets("Sheet1")
Dim column_number: column_number = 2

'Row starts from 2
For i=2 To 100
    strURL = sh.cells(i,column_number)
    sh.cells(i, column_number+1) = CallHTTPRequest(strURL)
Next


Function CallHTTPRequest(strURL)
    Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    objXMLHTTP.Open "GET", strURL, False
    objXMLHTTP.send
    status = objXMLHTTP.Status
    'strContent = ""

    'If objXMLHTTP.Status = 200 Then
    '   strContent = objXMLHTTP.responseText
    'Else
    '   MsgBox "HTTP Request unsuccessfull!", vbCritical, "HTTP REQUEST"
    '   Exit Function
    'End If
    Set objXMLHTTP = Nothing
    CallHTTPRequest = status
End Function

这篇关于VBA检查URL的状态的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！