Broken Links and any Error links check from the web page with VB Script / UFT / QTP

Some times our customers may requests us to check for links which are broken from the web pages. This might be from the production sites or from the any of the web home page in pre-production sites.

Following code snippet can be used as quick solution to fulfill our requirement.

''#########################################################################
'' Use this code to verify all links are working fine in a already opened web page
''#########################################################################
On Error Resume Next
Set objBrowser = Description.Create
objBrowser("name").Value = "XXXXXXX"
objBrowser("CreationTime").Value = 0
Set objPage = Description.Create
objPage("title").Value = "XXXXX"

Set objLink = Description.Create
objLink("micclass").value = "Link"
objLink("html tag").value =  "A"

Set objBP = Browser(objBrowser).Page(objPage)

Set colLinkObjects = objBP.ChildObjects(objLink)

'Display count of all links

'Msgbox colLinkObjects.Count

inputFilesPath = "D:\Sample\WebLinksCheck.xlsx"
strSheetName = "Sheet1"

For i=2 to colLinkObjects.Count

    strLinkURL =  colLinkObjects(i).GetROProperty("url")
    strLinkName = colLinkObjects(i).GetROProperty("Name")
    ExportData2ExcelFile inputFilesPath,strSheetName,i,1,strLinkName
    ExportData2ExcelFile inputFilesPath,strSheetName,i,2,strLinkURL

    strVerifyMsg = VerifyLinksBroken(strLinkURL)
    ExportData2ExcelFile inputFilesPath,strSheetName,i,3,strVerifyMsg

Next

On Error GoTo 0

'=======================================================================
'Function: ExportData2ExcelFile()
' Description: Exporting runtime value to excel file
'Input: 
' =======================================================================

Public Function ExportData2ExcelFile(inputFilesPath,strSheetName,ColName,intRowNum,strValue)

  On Error Resume Next
'    inputFilesPath = Environment.Value("DataPath")

Set ExcelObj = CreateObject("Excel.Application")
ExcelObj.Visible = False
Set objWorkbook = ExcelObj.Workbooks.Open(inputFilesPath)
Set worksheet = objWorkbook.WorkSheets(strSheetName)

worksheet.cells(ColName,intRowNum).value  = strValue

objWorkbook.Save
objWorkbook.Close
ExcelObj.Application.Quit
Set objWorkbook = Nothing
Set ExcelObj = Nothing

On Error GoTo 0
End Function



Public Function VerifyLinksBroken(strURL)
On Error Resume Next

  'Create a WinHTTP Request using the link's URL
  Set objWinHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
  objWinHTTP.Open "GET", strURL, False
  objWinHTTP.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MyApp 1.0; Windows NT 5.1)"

  'Send the Request to the Server and capture the response
  objWinHTTP.Send
  iReturnVal = objWinHTTP.Status
  strErrorMsg = objWinHTTP.StatusText

  'Find out if the Link exists or is broken
  If iReturnVal = 200 Then
    strMsg = "Link - " & strURL & " Exists"
  ElseIf iReturnVal = 404 Then
    strMsg =  "Link - " & strURL & " is Broken with 404 error"
  Else
    strMsg =  "Error Code - " & iReturnVal & ":"&strErrorMsg&": Problem with this page"
  End If

  Set objWinHTTP = Nothing

On Error GoTo 0
VerifyLinksBroken = strMsg
End Function