Here is the complete code of the application:
'Create the Excel object
Set objExcel = CreateObject("Excel.Application")
'Open the worksheet
objExcel.Workbooks.Open MYFILE
'Set the Transfer Protocol
Inet1.Protocol = icHTTP
'This is the main function!!
Public Sub Check_Links()
'This function will be called to check all the links in the
'worksheet.
'Declare variables
Dim var_row As Integer
Dim var_URL As String
Dim var_buffer As String
Dim var_msg As String
Dim var_file_not_found As Integer
Dim var_server_not_found As Integer
Dim var_timeout As Integer
Dim var_OK As Integer
'Catch the time-out errors
On Error Resume Next
'Set the row variable to the cell where the data starts
var_row = STARTROW
'Initialize the variables
var_timeout = 0
var_file_not_found = 0
var_OK = 0
var_server_not_found = 0
'Minimize the form
frmmain.WindowState = 1
'Loop through all the URLs
Do
'Get the URL
var_URL = objExcel.Cells(var_row, URL_COL)
'Check whether the first cell is empty
If var_URL = "" Then Exit Do
'Open the URL
Text1.Text = Inet1.OpenURL(var_URL)
'Avoid tying up the system
DoEvents
'Errors messages are found in the first 50 characters
'returned by the openurl method
If Len(Text1.Text) > 50 Then
var_buffer = Left(Text1.Text, 50)
Else
var_buffer = Text1.Text
End If
'Catch a time-out error
If Err = 35761 Then
var_msg = "Timed Out"
var_timeout = var_timeout + 1
Err.Clear
'If nothing is returned, it means that the server was
'not found
ElseIf Text1.Text = "" Then
var_msg = "Server not found"
var_server_not_found = var_server_not_found + 1
'If error 404 is returned from the URL, it means the
'server was found but he file was not found
ElseIf InStr(1, var_buffer, "404") Then
var_msg = "File not found"
var_file_not_found = var_file_not_found + 1
'else, the link is OK
Else
var_msg = "OK"
var_OK = var_OK + 1
End If
'Save the result back to the worksheet
objExcel.Cells(var_row, STATUS) = var_msg
'Move to the next row
var_row = var_row + 1
'Display the current status.
frmmain.Caption = var_OK + var_file_not_found + var_server_not_found
+ var_timeout
'Display the results on the form
Label1.Caption = "OK: " & var_OK
Label2.Caption = "File not found: " & var_file_not_found
Label3.Caption = "Server not found: " & var_server_not_found
Label4.Caption = "Timed out: " & var_timeout
Loop While True
'If all the links have been checked, restore the form
frmmain.WindowState = 0
'Close the Worksheet
objExcel.Workbooks.Close
'Remove the object from the memory
Set objExcel = Nothing
'Display the results
var_buffer = "OK: " & var_OK & vbCrLf
var_buffer = var_buffer & "Server not found: " & var_server_not_found & vbCrLf
var_buffer = var_buffer & "File not found: " & var_file_not_found & vbCrLf
var_buffer = var_buffer & "Timed out: " & var_timeout
MsgBox var_buffer
Open the Excel workbook and add the links you want the program to check. Close the workbook and run the program. Make sure you are connected to the internet. That's it.
Comments