imadoofus
03-17-2016, 07:33 AM
Trying to go through a long list of hyperlinks to see if they exist, if not highlight and tally. No popups or warnings ideally.
Not much vba background, so the existing code has been cobbled together from a few forums.
Can't seem to get it to work.
I am doing something blatantly obvious that is wrong?
Thanks for your help!
Sub check_links()
Dim tt_file As String
Dim file_ct As Integer: file_ct = 1 'Starting row for server locations
Dim file_ok As Integer: file_ok = 0
Dim file_missing As Integer: file_missing = 0
Dim wb As Workbook
Worksheets("Locations").Cells.ClearFormats
'''''' File or Web location operations
tt_file = "init"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While tt_file <> ""
tt_file = Worksheets("Locations").Range("A" & file_ct).Value
'MsgBox tt_file
On Error Resume Next
Set wb = Workbooks.Open(tt_file)
On Error GoTo 0
If Not wb Is Nothing Then
file_ok = file_ok + 1
wb.Close savechanges:=False
Else
file_missing = file_missing + 1
Sheets("Locations").Cells(file_ct, 1).Interior.Color = RGB(255, 255, 0) 'Yellow
End If
GoTo UPDATECTR
'Handler: file_missing = file_missing + 1
'MsgBox "filemissing"
'Sheets("Locations").Cells(file_ct, 1).Interior.Color = RGB(255, 255, 0) 'Yellow
UPDATECTR: file_ct = file_ct + 1
Loop
Application.DisplayAlerts = True
MsgBox "Links fine : " & file_ok & " Missing links : " & file_missing & " (highlighted)"
End Sub
Not much vba background, so the existing code has been cobbled together from a few forums.
Can't seem to get it to work.
I am doing something blatantly obvious that is wrong?
Thanks for your help!
Sub check_links()
Dim tt_file As String
Dim file_ct As Integer: file_ct = 1 'Starting row for server locations
Dim file_ok As Integer: file_ok = 0
Dim file_missing As Integer: file_missing = 0
Dim wb As Workbook
Worksheets("Locations").Cells.ClearFormats
'''''' File or Web location operations
tt_file = "init"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While tt_file <> ""
tt_file = Worksheets("Locations").Range("A" & file_ct).Value
'MsgBox tt_file
On Error Resume Next
Set wb = Workbooks.Open(tt_file)
On Error GoTo 0
If Not wb Is Nothing Then
file_ok = file_ok + 1
wb.Close savechanges:=False
Else
file_missing = file_missing + 1
Sheets("Locations").Cells(file_ct, 1).Interior.Color = RGB(255, 255, 0) 'Yellow
End If
GoTo UPDATECTR
'Handler: file_missing = file_missing + 1
'MsgBox "filemissing"
'Sheets("Locations").Cells(file_ct, 1).Interior.Color = RGB(255, 255, 0) 'Yellow
UPDATECTR: file_ct = file_ct + 1
Loop
Application.DisplayAlerts = True
MsgBox "Links fine : " & file_ok & " Missing links : " & file_missing & " (highlighted)"
End Sub