Controlling multiple Access Databases from one Access Database 1

[rdmartin]

I am trying to run various scripts and modules in external Access databases that will update tables with current information. I am running into errors due to the tables being opened by other scripts which have prevented my scripts from opening the tables exclusivly. I am looking for a way to error trap the opening event and then adding the error to a log table in order to determine which databases could not be opened exclusively.

 

[beetee]

You want to use access error handling

here's an example

Function DoSomething

On error goto DoSomethingError

docmd.openreport "This is a report", acviewPreview

DoSomethingExit:
exit function

DoSomethingError:
debug.print Err.Number & ", " & Err.Description
resume DoSomethingExit
end function


You can also perform error logging by writing function(s)
to log errors, e.g.
NOTE: this code is sketchy, but should give the idea

dim ErrorLogOpened as boolean
dim ErrorLogHandle as integer

sub OpenErrorLog
if not ErrorLogOpened then
ErrorLogHandle = FreeFile
open "TheLog" for output as ErrorLogHandle
ErrorLogOpened = true
end sub

sub WriteToErrorLog(What as string)
OpenErrorLog
print #ErrorLogHandle, What
end sub

sub CloseErrorLog
if ErrorLogOpened then
Close #ErrorLogHandle
ErrorLogOpened = false
endif
end sub

 

[rdmartin]

I appreciate the information, but let me clarify some things on this situation. I am aware of Access Error Handeling. I need to open external Access Databases. I then run macros inside these databses to control code modules that delete table contents, and then re-populate the data tables. This has its own error checking. What I need to error log is the action of the Primary Database attempting to open the Secondary Databases exclusevly. If successful then go ahead and run the secondary database macro's and modules. If unsucessful I need to trap that event and then log that error. That way I can find out which updated and which did not and improve the debugging and timing concerns. I hope this makes the problem clearer.

 

[beetee]

HTH:


Dim ErrorLogOpened As Boolean
Dim ErrorLogHandle As Integer

Sub OpenErrorLog()
If Not ErrorLogOpened Then
ErrorLogHandle = FreeFile
Open "c:\TheLog.txt" For Output As ErrorLogHandle
ErrorLogOpened = True
End If
End Sub

Sub WriteToErrorLog(What As String)
OpenErrorLog
Print #ErrorLogHandle, What
End Sub

Sub CloseErrorLog()
If ErrorLogOpened Then
Close #ErrorLogHandle
ErrorLogOpened = False
End If
End Sub

Function MyOpenDatabase(DbName As String) As Boolean
On Error GoTo MyOpenDatabaseError
Dim ExtDatabase As Database
Set ExtDatabase = DBEngine.Workspaces(0).OpenDatabase(DbName, True)

Dim CurTblDef As TableDef
For Each CurTblDef In ExtDatabase.TableDefs
Debug.Print CurTblDef.Name
Next CurTblDef

ExtDatabase.Close
Set ExtDatabase = Nothing

MyOpenDatabaseExit:
Exit Function

MyOpenDatabaseError:
WriteToErrorLog "Error while oepning " & DbName & Err.Number & ", " & Err.Description
Resume MyOpenDatabaseExit
End Function

Sub TestIt()
Debug.Print MyOpenDatabase("d:\access\awards\awards_be.mdb&quot
CloseErrorLog
End Sub

 

[beetee]

Please note that on the above sample code I was accessing some tabledef objects just for fun. I neglected to take it out.

 

[beetee]

Belay all previous versions, this is a bit better:


Option Compare Database
Option Explicit

Dim ErrorLogOpened As Boolean
Dim ErrorLogHandle As Integer

Sub OpenErrorLog()
If Not ErrorLogOpened Then
ErrorLogHandle = FreeFile
Open "c:\TheLog.txt" For Append As ErrorLogHandle
ErrorLogOpened = True
End If
End Sub

Sub WriteToErrorLog(What As String)
OpenErrorLog
Print #ErrorLogHandle, What
End Sub

Sub CloseErrorLog()
If ErrorLogOpened Then
Close #ErrorLogHandle
ErrorLogOpened = False
End If
End Sub

Function MyOpenDatabase(DbName As String) As Database
On Error GoTo MyOpenDatabaseError
Dim ExtDatabase As Database
Set ExtDatabase = Nothing
Set ExtDatabase = DBEngine.Workspaces(0).OpenDatabase(DbName, True)

Set MyOpenDatabase = ExtDatabase

MyOpenDatabaseExit:
Exit Function

MyOpenDatabaseError:
WriteToErrorLog "Error while oepning " & DbName & Err.Number & ", " & Err.Description
Resume MyOpenDatabaseExit
End Function

Sub TestIt()
Const c_DbName = "d:\access\awards\awards_be.mdb"

Dim TheDatabase As Database
Set TheDatabase = MyOpenDatabase(c_DbName)
If TheDatabase Is Nothing Then
Debug.Print "Open " & c_DbName & " failed"
Else
Debug.Print "Opened " & TheDatabase.Name
End If
CloseErrorLog
End Sub