1) Save this code as Brtokenlink.vbs
Dim WshShell
Dim met
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
objExcel.Workbooks.open ("D:\result\result.xlsx")
Set WshShell = WScript.CreateObject("WScript.Shell")
Set oIE = CreateObject("InternetExplorer.Application")
oIE.Visible = True
site="http:// set the website address here"
oIE.navigate site
Do While oIE.Busy
Wscript.Sleep 500
Loop
Set links=oIE.Document.getElementsByTagName("A")
For i =0 To oIE.Document.getElementsByTagName("A").length-1
url=links(i).href
'Call ClearBrowserCache()
Set webService = nothing
Set webService= CreateObject("Microsoft.XMLHTTP")
On Error Resume Next
webService.open "GET", url, False
On Error Resume Next
webService.Send (null)
If webService.status < 200 or webService.status >399 Then
objExcel.Cells(i+2, 1).Value = i+1
objExcel.Cells(i+2, 2).Value = links(i).text
objExcel.Cells(i+2, 3).Value = url
objExcel.Cells(i+2, 4).Value = "In valid request "& webService.status
geturlstatus = 0
else
geturlstatus = 1
objExcel.Cells(i+2, 1).Value = i+1
objExcel.Cells(i+2, 2).Value = links(i).innertext
objExcel.Cells(i+2, 3).Value = url
objExcel.Cells(i+2, 4).Value = "valid request "& webService.status
End If
Set webService = nothing
err.clear
next
Public Function ClearBrowserCache()
On Error Resume Next
Const TEMPORARY_INTERNET_FILES=32
Set objCacheFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(TEMPORARY_INTERNET_FILES)
objCacheFSO.DeleteFile(objFolder.Self.Path & "\*.*")
sPath = objCacheFSO.GetFolder(objFolder.Self.path) & "\Content.IE5\"
Set objFolders = objCacheFSO.GetFolder(sPath)
For Each objFName In objFolders.SubFolders
objCacheFSO.DeleteFolder sPath & objFName.Name, True
Next
ClearBrowserCache= True
Set objFolder=Nothing
Set objShell=Nothing
Set objCacheFSO=Nothing
err.clear
End Function
objExcel.ActiveWorkBook.SaveAs "result.xlsx"
objExcel.Quit
oIE.quit
MsgBox "Task Completed"
2) create D://result/result.xls to see the result.
No comments:
Post a Comment