Access97, Dir() error 2

[ehicks727]

I have a file that will be located on different network paths in different offices across the country. I have my code working mostly right to delete all the tables and relink them based on what office the user picks from a combo box. It works when a user picks the correct office that they are physically in, and it also works if they pick an office that I haven't set up yet (returns error msg that the office isnt' set up yet). The problem occurs when the user is physically in Tampa, but picks another office, such as Milwaukee, that is setup, but the network path doesn't exist because they aren't in that office.

The error seems to be happening in the Dir() function. I get a runtime error 68. Device unavailable.

I'm not so good with error trapping (access or vba isn't my best skill), but my guess is there is a way to catch this error to produce a msgbox and make the user pick again, without breaking the code. Can someone help? I'm even open for completely different ways of handling this process. Thanks.

Private Sub linkTables()

    Dim dbPath As String
    Dim tdf As TableDef
    Dim x As Boolean
    
    x = False
    For Each tdf In CurrentDb.TableDefs
        If tdf.Attributes And dbAttachedTable Then
            CurrentDb.TableDefs.Delete tdf.name
        End If
    Next
    
    Dim mkt As String
    mkt = Me!cmbMarket
    
    Select Case Trim(mkt)
    Case "Tampa FL"
        dbPath = "E:\ProviderTRAC\data\ProviderTRAC_DATA.mdb"
        x = True
    Case "Milwaukee WI"
        dbPath = "v:\network_dept\providertrac\data\ProviderTRAC_DATA.mdb"
        x = True
    Case Else
        'insert error msg
        x = False
    End Select
    
    'MsgBox Dir(dbPath)
    
    If x = True Then
        If Dir(dbPath, vbNormal) <> "" Then
            DoCmd.TransferDatabase acLink, "Microsoft Access", dbPath, acTable, "Providers", "Providers"
            DoCmd.TransferDatabase acLink, "Microsoft Access", dbPath, acTable, "Groups", "Groups"
            DoCmd.TransferDatabase acLink, "Microsoft Access", dbPath, acTable, "GrpNotes", "GrpNotes"
            DoCmd.TransferDatabase acLink, "Microsoft Access", dbPath, acTable, "Hospitals", "Hospitals"
            DoCmd.TransferDatabase acLink, "Microsoft Access", dbPath, acTable, "Markets", "Markets"
            DoCmd.TransferDatabase acLink, "Microsoft Access", dbPath, acTable, "ProvNotes", "ProvNotes"
            DoCmd.TransferDatabase acLink, "Microsoft Access", dbPath, acTable, "Users", "Users"
            DoCmd.TransferDatabase acLink, "Microsoft Access", dbPath, acTable, "Zipcodes", "Zipcodes"
            CurrentDb.TableDefs.Refresh
        Else
            'insert error msg
        End If
    Else
        'insert error msg
    End If
    
End Sub

 

[SJMcAbney]

Here's a suggestion for you.

Why are you relying on the user to select where they are from a combobox when you can set the computer up to do this itself?

i.e.

Write a small function that tries to connect to each of your systems and returns the one that it can.

Public Function FindPath() As String

Const dbName As String = "ProviderTRAC_DATA.mdb"
Const Florida As String = "E:\ProviderTRAC\data\"
Const Milwaukee As String = "v:\network_dept\providertrac\data\"

If IsFile(Florida & dbName) Then FindPath = Florida & dbName
If IsFile(Milwaukee & dbName) Then FindPath = Milwaukee & dbName

End Function


Private Function IsFile(strPath As String) As Boolean

On Error GoTo Err_IsFile

Dim lngLength As Long

lngLength = FileLen(strPath)
IsFile = True

Exit_IsFile:
Exit Function

Err_IsFile:
IsFile = False
Resume Exit_IsFile

End Function

 

[ehicks727]

That makes a lot of sense... Thank you for the suggestion, let me try to implement it and I'll let you know how it works! Thank you.

 

[VBslammer]

You can also trap Dir() errors in the same manner, 68 and 71 are the most common errors:

Private Sub linkTables()
On Error GoTo ErrHandler

    Dim dbPath As String
    Dim tdf As TableDef
    Dim msg As String
    Dim x As Boolean
    
    x = False
    For Each tdf In CurrentDb.TableDefs
        If tdf.Attributes And dbAttachedTable Then
            CurrentDb.TableDefs.Delete tdf.Name
        End If
    Next

    Dim mkt As String
    mkt = Me!cmbMarket

    Select Case Trim(mkt)
    Case "Tampa FL"
        dbPath = "E:\ProviderTRAC\data\ProviderTRAC_DATA.mdb"
        x = True
    Case "Milwaukee WI"
        dbPath = "v:\network_dept\providertrac\data\ProviderTRAC_DATA.mdb"
        x = True
    Case Else
        msg = "Unrecognized location selected."
        x = False
    End Select
    
    If x = True Then
        If dir(dbPath, vbNormal) <> "" Then
            DoCmd.TransferDatabase acLink, "Microsoft Access", dbPath, acTable, "Providers", "Providers"
            DoCmd.TransferDatabase acLink, "Microsoft Access", dbPath, acTable, "Groups", "Groups"
            DoCmd.TransferDatabase acLink, "Microsoft Access", dbPath, acTable, "GrpNotes", "GrpNotes"
            DoCmd.TransferDatabase acLink, "Microsoft Access", dbPath, acTable, "Hospitals", "Hospitals"
            DoCmd.TransferDatabase acLink, "Microsoft Access", dbPath, acTable, "Markets", "Markets"
            DoCmd.TransferDatabase acLink, "Microsoft Access", dbPath, acTable, "ProvNotes", "ProvNotes"
            DoCmd.TransferDatabase acLink, "Microsoft Access", dbPath, acTable, "Users", "Users"
            DoCmd.TransferDatabase acLink, "Microsoft Access", dbPath, acTable, "Zipcodes", "Zipcodes"
            CurrentDb.TableDefs.Refresh
        Else
            msg = "Could not locate the selected path."
        End If
    End If
    
ExitHere:
  On Error Resume Next
  
  ' check for error message before exiting:
  If Len(msg) > 0 Then
    MsgBox msg, vbExclamation + vbOKOnly, "Attention:"
  End If
  
  Exit Sub
  
ErrHandler:
  Select Case Err.Number
    Case 68   'invalid path
      msg = "Could not locate the selected path."
    Case 71   'no disk in floppy
      msg = "There is no disk in the floppy drive."
    Case Else 'all other errors
      msg = "An unexpected error occurred: " & Err & "-" & Err.Description
  End Select
  Resume ExitHere
End Sub

VBSlammer

Unemployed in Houston, Texas

 

[SJMcAbney]

Personally, faced with this, I think I'd design a Network/File Handling Class so I need never have to look at all the code...unless I want to improve on it or add to it.

 

[VBslammer]

I would too, but Access and all its "Macro generated" code lulls the new developers into the sequential programming habit. I'm amazed at how few people actually implement a design phase before they start hacking away...

VBSlammer

Unemployed in Houston, Texas

 

[SJMcAbney]

I know what you mean.

If I see one more stLinkCriteria

 

[ehicks727]

I think I'm going to merge both of your responses... I'm going to test for the file before the user even picks with a msgbox that says something like "I've detected you at the Tampa office, is the correct?" with a yes/no selection.

However, when my code goes to relink the tables, if I just happen to get an error message, I need to "contain" the code somehow so that it doesn't break, or ask the user to debug, or something like that. I need to just need to inform the user that there is an error and dump them back to the office selector without breaking.

with that said, I have two questions... in SJMcAbney's reply, does this logic rely on detecting the length of the path/filename to determine which office it is? I'm talking about the FileLen(strPath) line, in particular. The only caveat to this would be if I have two path/filenames the same length, correct? I only included 2 offices... I have about 20 to input still... I may end up with a dupe this way.

Is there another way of detecting if a file exists? That's why I was playing with Dir(), but it has been causing me problems that I can't resolve.

My next question is for VBSlammer... using your error trapping method, where does the user end up after the code catches the error? I'm not familiar with VB's exception handling, sorry. Where does "On Error Resume Next" dump the user?? thanks.

BTW, yes, I know this is insane to deploy an app like this... I asked to implement a SQL server solution, but they wouldn't let me do the centralized server route.... oh well, such is corporate policy!!

 

[ehicks727]

I agree with you two about the "network/file handling class" deal. Normally I don't do stuff like this, but I'm a java programmer that was told to develop an access app, so I had about two weeks to teach myself VBA and roll out this app. I haven't had time to fully learn the VBA exception handling methods... I'm kind of at break-neck speed with this thing... it's has to work tomorrow morning!!

 

[SJMcAbney]

The FileLen() function returns the length of a file in bytes. The IsFile() custom function is just returning a True or False depending on whether the database exists on the specified server - the function just uses FileLen() on the possibility that it might throw up an error so that we can say 'This is not a legitimate path therefore this user is not in Tampa'.

If you have 20 different offices I'd recommend putting them into a table - you probably already have a table for offices but adding a new field called 'Path' or something like that means you can cycle through the office recordset and test each office with the minimum of code

ie.

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strPath As String
Set db = CurrentDb
Set rs = db.OpenRecordset("tblOffices")
With rs
Do While Not .EOF
If IsFile(.Fields("Path")) Then
strPath = .Fields("Path")
Exit Do
End If
Loop
.Close
End With
Set rs = Nothing
Set db = Nothing

 

[ehicks727]

Sorry, I think I get it, SJMcAbney..... the FileLen(strPath) will error out if the file doesn't exists. I should have looked at that closer. Ignore my other post asking about that....

 

[ehicks727]

I think we're replying at the same time!!! Thank you for replying though... you gave me another good suggestion, I'll implement that one too.

This is what I love about Tek-Tips!!! Thanks.

 

[VBslammer]

As for the error handling, it's pretty simplistic in VB, much less elegant than a try...catch...finally. But here is the nutshell version for people who have to be done TOMORROW!:

[blue]Sub[/blue] ErrTest()

[blue]On Error GoTo[/blue] LineLabel2        [green]'<-- turn on the error handler and tell
                                '    it which line label to jump to
                                '    if an error occurs.[/green]





[green]'[your error-prone code here][/green]




 

LineLabel1:                     [green]'<-- a line label for exiting the procedure.[/green]

  [blue]On Error Resume Next[/blue]          [green]'<-- this isn't alwasy required,
                                '    but if you do any chores in
                                '    this area and an error occurs,
                                '    you'd be stuck in an endless loop,
                                '    so Resume Next does what it says,
                                '    keeping you out of trouble.[/green]

  [blue]Exit Sub[/blue]                      [green]'<-- normal sequential exit.[/green]

LineLabel2:                     [green]'<-- the line label to jump to on errors.
                                '    normally you'd never get this far.[/green]

  [blue]Resume[/blue] LineLabel1             [green]'<-- clear error, jump to LineLabel1[/green]

[blue]End Sub[/blue]

A final not on the line labels, in early versions of basic you had to use unique names for each line label in your application, which is why the Macro Generator in Access still uses verbose names like:

[tt]Form_CustomerOrdersSubformUnload_Exit:[/tt]

Now you can use a consistent naming scheme for the basic labels you use in every function, and create unique labels for special circumstances.

I use [tt]ErrHandler[/tt] and [tt]ExitHere[/tt] in just about every routine, which makes my code easier for me to read because it is so familiar. When I see the Macro Generated code and its funky line labels it makes my eyes go blurry!

VBSlammer

Unemployed in Houston, Texas

 

[ehicks727]

Thanks for helping me out, both... I used all of your suggestions and they work well. I gave ya both stars...

FYI, SJMcAbney... the loop below needed a .movenext The code did work well until I used it to connect to the second path in my loop! It only took about 5 minutes to figure out.. no harm done.

Here's the corrected code if anyone uses this example in the future.

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strPath As String
Set db = CurrentDb
Set rs = db.OpenRecordset("tblOffices")
With rs
    Do While Not .EOF
        If IsFile(.Fields("Path")) Then
            strPath = .Fields("Path")
            Exit Do
        End If
        .movenext
    Loop
    .Close
End With
Set rs = Nothing
Set db = Nothing

 

[SJMcAbney]

Sorry. I was writing it from scratch without testing so its expected that I can get something wrong.

Glad it's sorted.

Stewart