Hi,
Below function when put in a function library is not returning values, while the same copied to same script works.
Note:Script is associated with the library & other sub procedures in the same library called by the same script are working fine.
Below is the code in the script:
Below function when put in a function library is not returning values, while the same copied to same script works.
Note:Script is associated with the library & other sub procedures in the same library called by the same script are working fine.
Below is the code in the script:
Code:
Set myxl=nothing
Set myxl=Createobject("Excel.Application")
myxl.Application.Visible=True
User="sfp"
'Create Link object
Set weblnk=nothing
Set weblnk=description.Create
weblnk("micclass").value="Link"
Set objAlllinkobj=Nothing
Set objAlllinkobj=Browser("title:=.*","micclass:=Browser").Page("title:=.*","micclass:=Page").ChildObjects(weblnk)
''Create excel file to write data
Environment.Value("Alllinksfile")= "C:\Linkcheck\" & User & ".xlsx"
filepath=Environment.Value("Alllinksfile")
Set fso=Createobject("Scripting.FileSystemObject")
If fso.FileExists(filepath) Then
fso.DeleteFile filepath
End If
Set xlbok=myxl.Workbooks.Add
Set mysheet=nothing
Set mysheet=myxl.Worksheets("Sheet1")
mysheet.cells(1,1)="Link"
mysheet.cells(1,2)="Status"
mysheet.cells(1,3)="Error Code"
mysheet.cells(1,4)="URL"
For a=0 to objAlllinkobj.count-1
roc=mysheet.usedrange.rows.count
url = objAlllinkObj(a).getroproperty("href")
'msgbox url
nam=objAlllinkObj(a).getroproperty("name")
'URL status
Call Geturlstatus (url)
Next
*************************************
Function Geturlstatus(url)
On Error Resume Next
'Call ClearBrowserCache()
Set objhttp = nothing
Set objhttp= CreateObject("Microsoft.XMLHTTP") ' Create an xmlhttp object
objhttp.open "GET", url, False ' Opens the connection to the remote server
objhttp.Send
pagestatus = objhttp.status
If pagestatus >= "200" or pagestatus <= "206" Then
mysheet.cells(roc+1,1)=nam
mysheet.cells(roc+1,2)="Success"
mysheet.cells(roc+1,3)=pagestatus
mysheet.cells(roc+1,4)=url
'geturlstatus = 0
elseif pagestatus >= "302" or pagestatus <= "307" Then
mysheet.cells(roc+1,1)=nam
mysheet.cells(roc+1,2)="Redirection"
mysheet.cells(roc+1,3)=pagestatus
mysheet.cells(roc+1,4)=url
'geturlstatus = 0
elseif pagestatus >= "400" or pagestatus <= "423" Then
mysheet.cells(roc+1,1)=nam
mysheet.cells(roc+1,2)="Client Error"
mysheet.cells(roc+1,3)=pagestatus
mysheet.cells(roc+1,4)=url
'geturlstatus = 0
elseif pagestatus >= "500" or pagestatus <= "505" Then
mysheet.cells(roc+1,1)=nam
mysheet.cells(roc+1,2)="Server Error"
mysheet.cells(roc+1,3)=pagestatus
mysheet.cells(roc+1,4)=url
' geturlstatus = 1
End If
Set objhttp = nothing
End Function
**************************************************