VBA檢查URL的狀態

我已經創建了宏，我可以從任何網頁中獲取每個URL。VBA檢查URL的狀態

現在，我在列中有每個URL。

任何人都可以幫助寫入宏來檢查這個URL是否工作。如果這個URL中的任何一個沒有工作，那麼它應該是錯誤的，不會在下一列的URL旁邊工作。

下面是我寫不過似乎這是不工作的代碼：

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

本規範來從網頁的URL。

下面的代碼我試圖檢查URL的狀態，如果它的工作與否。

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

但是，此代碼無法正常工作，請向我推薦更改。

問候， MAYUR Alaspure

來源

2016-08-18 Mayur Alaspure

嘗試圍繞這些鏈接https://msdn.microsoft.com/en-us/library/ms767625(v=vs.85).aspx和https://msdn.microsoft東西。 com/en-us/library/windows/desktop/aa383887（v = vs.85）.aspx –

既然你有興趣知道該鏈接是否工作，XMLHTTP可能是一個解決方案。

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

來源

2016-08-18 13:59:13 Barney

Hi Barney，謝謝你輸入這段代碼， –

要檢查鏈接的狀態，你只需要做一個HEAD請求：沒有必要獲取完整的內容。 –

嗨巴尼，謝謝fort這段代碼，我想我需要從代碼中刪除評論，然後它工作正常。 –

Public Function IsURLGood(url As String) As Boolean 
    Dim request As New WinHttpRequest 

    On Error GoTo IsURLGoodError 
    request.Open "HEAD", url 
    request.Send 
    If request.Status = 200 Then 
     IsURLGood = True 
    Else 
     IsURLGood = False 
    End If 
    Exit Function 

IsURLGoodError: 
    IsURLGood = False 
End Function 

Sub testLink() 

Dim source As Range, req As Object, url$ 



    Set source = Range("A2:B2") 


    source.Columns(2).Clear 


    For i = 1 To source.Rows.Count 

    url = source.Cells(i, 1) 
    If IsURLGood(url) Then 
    source.Cells(i, 2) = "OK" 
    Else 
    source.Cells(i, 2) = "Down" 
    End If 

Next 

    MsgBox "Done" 

End Sub

來源

2017-11-13 13:12:33 WileyJohn

VBA檢查URL的狀態

回答

相關問題