Tuesday, September 6, 2011

Check link are broken or not


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