I have already checked Tools > Options > General > Error Trapping in VBE - I have set it to both "Break in Class Module" and "Break on Unhandled Errors" and either way it still throws the error. The error is thrown on the line:
Set xlContacts = Workbooks(LocalContactsFilename)
It throws an error saying the subscript is out of range, and I understand that this means the index was not found within the Workbooks collection, this statement is here because usually the file is already open as an addin so I can just get a reference to it through this statement. It is supposed to resume on this error because if the file is not open I open it.
One odd thing I noticed about this- even though this line of code is not accessing any remote files or the network, it only throws this error when I am disconnected from the network. If I open the workbook while connected to the network this error is not thrown.
Has anyone experienced this before? When your options are set to only halt on unhandled exceptions but it halts anyways?
Public Sub openContactsFile()
On Error Resume Next
Dim fso As New FileSystemObject
Dim LocalContactsPath As String
Dim LocalContactsFilename As String
Dim LocalContactsShortFilename As String
LocalContactsPath = wbMyCompanyWorkbook.Names("localContactsPath").RefersToRange.Value
LocalContactsFilename = Mid(LocalContactsPath, (InStrRev(LocalContactsPath, "\") + 1))
LocalContactsShortFilename = Mid(LocalContactsFilename, 1, (InStrRev(LocalContactsFilename, ".") - 1))
'On Error Resume Next
Application.ScreenUpdating = False
If Not fso.FileExists(LocalContactsPath) Then
If MsgBox("The contacts file is not available. Click Yes to update the contacts now, or No to use the workbook without contact auto-fill capability.", vbYesNo, ThisWorkbook.NAME) = vbYes Then
SyncContacts
Else
GoTo cancelParse
End If
End If
If fso.FileExists(LocalContactsPath) Then
On Error GoTo catch_no_remote_connection
If fso.GetFile(LocalContactsPath).DateLastModified < fso.GetFile(wbMyCompanyWorkbook.Names("remoteContactsPath").RefersToRange.Value).DateLastModified Then
If MsgBox("Your local contacts file appears to be out of date, would you like to download the latest contacts file?", vbYesNo Or vbQuestion, ThisWorkbook.NAME) = vbYes Then
SyncContacts
End If
End If
catch_no_remote_connection:
If Err.Number = 53 Then Err.CLEAR
On Error Resume Next
Set xlContacts = Workbooks(LocalContactsFilename)
If xlContacts Is Nothing Then
Set xlContacts = Workbooks.Open(LocalContactsPath, False, True)
End If
xlContacts.Sheets(1).Range("A1:CN2000").Sort Key1:=xlContacts.Sheets(1).Range("F2"), Order1:=xlAscending, Key2:=xlContacts.Sheets(1).Range("B2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
End If
'hide the contacts from view or editing
On Error Resume Next
If Not Workbooks(LocalContactsFilename) Is Nothing Then xlContacts.IsAddin = True
Err.CLEAR
On Error GoTo 0
cancelParse:
Application.ScreenUpdating = True
Exit Sub
End Sub
Thanks in advance for any help with this!
@TimWilliams
Thank you for the answer- I assumed Err.CLEAR resets the error handling but it does not. The code below functions correctly whether connected to the network or not (which I realize now was the origin of the problem), the problem was when it threw the file not found error and went to catch_no_remote_connection, there was no resume to clear the error, so I added this to close out the error handling block and reset the handler:
Resume post_err
post_err:
Functional Code:
Public Sub openContactsFile()
On Error Resume Next
Dim fso As New FileSystemObject
Dim LocalContactsPath As String
Dim LocalContactsFilename As String
Dim LocalContactsShortFilename As String
LocalContactsPath = wbMyCompanyWorkbook.Names("localContactsPath").RefersToRange.Value
LocalContactsFilename = Mid(LocalContactsPath, (InStrRev(LocalContactsPath, "\") + 1))
LocalContactsShortFilename = Mid(LocalContactsFilename, 1, (InStrRev(LocalContactsFilename, ".") - 1))
Application.ScreenUpdating = False
If Not fso.FileExists(LocalContactsPath) Then
If MsgBox("The contacts file is not available. Click Yes to update the contacts now, or No to use the workbook without contact auto-fill capability.", vbYesNo, ThisWorkbook.NAME) = vbYes Then
SyncContacts
Else
GoTo cancelParse
End If
End If
If fso.FileExists(LocalContactsPath) Then
On Error GoTo catch_no_remote_connection
If fso.GetFile(LocalContactsPath).DateLastModified < fso.GetFile(wbMyCompanyWorkbook.Names("remoteContactsPath").RefersToRange.Value).DateLastModified Then
If MsgBox("Your local contacts file appears to be out of date, would you like to download the latest contacts file?", vbYesNo Or vbQuestion, ThisWorkbook.NAME) = vbYes Then
SyncContacts
End If
End If
catch_no_remote_connection:
'there is no network connection, clear the error and resume from here
Err.CLEAR
Resume post_err
post_err:
On Error Resume Next
'get reference to the workbook if it is already open
Set xlContacts = Workbooks(LocalContactsFilename)
If xlContacts Is Nothing Then
'the workbook was not open, open it
Set xlContacts = Workbooks.Open(LocalContactsPath, False, True)
End If
'sort contacts by company, name
xlContacts.Sheets(1).Range("A1:CN2000").Sort Key1:=xlContacts.Sheets(1).Range("F2"), Order1:=xlAscending, Key2:=xlContacts.Sheets(1).Range("B2"), Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
End If
'hide the contacts from view or editing by setting the workbook as an Addin
On Error Resume Next
If Not Workbooks(LocalContactsFilename) Is Nothing Then xlContacts.IsAddin = True
Err.CLEAR
On Error GoTo 0
cancelParse:
Application.ScreenUpdating = True
Exit Sub
End Sub
Thank you all for taking the time to look at this!