Database locking

[jeffwest21]

I have a database that I take a 1/2 hourly update from into a SQL database so that I can do hourly reporting (client requirement), the issue i am sometimes faced with is if a user is in the process of logging in( I have multiple users), the process I have to do this says that the database is locked to user *****.

The process I have is another access database that takes the main table is linked to it in the main database, and sends the data to the SQL database, two questions here I guess.

1. How can I put a routine in my VBA code that if this occurs it waits for 30 seconds and trys again (does this until successful)
2. Is there a better way to link my table to a SQL database without reversing this so the SQL database table is imported into the database (This is a short term project so doesn't need this bit)

While normally this isn't a problem, because they use it at weekends and into the early evening I am not alsways around to kick this manually.

'Clever boy...'

 

[lameid]

I think some specifics on how you are doing what you are doing are in order as I expect there are different answers depending which object model you are using and where you are at on it.

 

[sparkbyte]

I have a module that I have built using many examples of how to link SQL tables in VBA.

You should be able to modify it to to what you are needing if you just need a way to quickly link to a SQL Server and the tables within a DB.

Option Compare Database

Public Function LinkAllTables(Server As Variant, Database As Variant, _
                            OverwriteIfExists As Boolean, _
                            Optional Schema As Variant)
                            If IsMissing(Schema) = True Then Schema = "dbo"
                            
On Error GoTo Error_Handler

    'Usage Example:  Call linkalltables("SQL01","SQLDB", true, "HR")
    
    ' (link all tables in database "SQLDB" on SQL Server Instance SQO01,
    ' in the 'dbo' and 'HR' schema's overwriting any existing linked tables.

    'This will also update the link if the underlying table definition has been modified.

    Dim rsTableList As New ADODB.Recordset
    Dim sqlTableList As String

    sqlTableList = "SELECT [TABLE_SCHEMA] + '.' + [TABLE_NAME] as TableName"
    sqlTableList = sqlTableList + " FROM [INFORMATION_SCHEMA].[TABLES]"
    sqlTableList = sqlTableList + " INNER JOIN [sys].[all_objects]"
    sqlTableList = sqlTableList + " ON [INFORMATION_SCHEMA].[TABLES].TABLE_NAME = [sys].[all_objects].[name]"
    sqlTableList = sqlTableList + " WHERE [sys].[all_objects].[type]=N'U' AND [sys].[all_objects].[is_ms_shipped]<>1"
    
    rsTableList.Open sqlTableList, BuildNativeSQLConnectionString(Server, Database)
       
'    If rsTableList.EOF Then
'        Debug.Print "SQL Native Client:  No Tables Found"
'    Else
'        rsTableList.Open sqlTableList, BuildSQLConnectionString(Server, Database)
'            If rsTableList.EOF Then
'            Debug.Print "SQL Client:  No Tables Found"
'            End If
'    End If

Function_Continue:

    Dim arrSchema As Variant
    While Not rsTableList.EOF
      arrSchema = Split(rsTableList("TableName"), ".", , vbTextCompare)
      
        Select Case LCase(arrSchema(0))
            Case "common"
                If LinkTable(arrSchema(1), Server, Database, rsTableList("TableName"), OverwriteIfExists) Then
'                Debug.Print "Linking common table " & rsTableList("TableName")
                End If
            Case LCase(Schema)
                If LinkTable(arrSchema(1), Server, Database, rsTableList("TableName"), OverwriteIfExists) Then
'                Debug.Print "Linking schema table " & rsTableList("TableName")
                End If
            Case Else
                'Skip
        End Select
                
    rsTableList.MoveNext
    Wend

Error_Handler:
    If Err.Number = -2147467259 Then
        rsTableList.Open sqlTableList, BuildSQLConnectionString(Server, Database)
        GoTo Function_Continue
    End If
    
    GoTo Function_Quit

Function_End:
    On Error GoTo Function_Quit
    rsTableList.Close
    GoTo Function_Quit
    
Function_Quit:
    Set rsTableList = Nothing
    
End Function

Function LinkTable(LinkedTableAlias As Variant, Server As Variant, Database As Variant, SourceTableName As Variant, OverwriteIfExists As Boolean)
On Error GoTo Error_Handler

    'This method will also update the link if the underlying table definition has been modified.

    'The overwrite parameter will cause it to re-map/refresh the link for LinktedTable Alias, but only if it was already a linked table.
    ' it will not overwrite an existing query or local table with the name specified in LinkedTableAlias.

    'Links to a SQL Server table without the need to set up a DSN in the ODBC Console.
    Dim dbsCurrent As Database
    Dim tdfLinked As TableDef

    ' Open a database to which a linked table can be appended.
    Set dbsCurrent = CurrentDb()

    'Check for and deal with the scenario of the table alias already existing
    If TableNameInUse(LinkedTableAlias) Then

        If (Not OverwriteIfExists) Then
            Debug.Print "Can't use name '" + LinkedTableAlias + "' because it would overwrite existing table."
            Exit Function
        End If

        'delete existing table, but only if it is a linked table
        If IsLinkedTable(LinkedTableAlias) Then
            dbsCurrent.TableDefs.Delete LinkedTableAlias
            dbsCurrent.TableDefs.Refresh
        Else
            Debug.Print "Can't use name '" + LinkedTableAlias + "' because it would overwrite an existing query or local table."
            Exit Function
        End If
    End If

    'Create a linked table
    Set tdfLinked = dbsCurrent.CreateTableDef(LinkedTableAlias)
    tdfLinked.SourceTableName = SourceTableName
    tdfLinked.Connect = "ODBC;" & BuildNativeSQLConnectionString(Server, Database)

Function_Continue:
    dbsCurrent.TableDefs.Append tdfLinked
    GoTo Function_End:
   
Error_Handler:
'    Debug.Print "ErrorNumber: " & Err.Number & vbCrLf & "ErrorDesc: " & Err.Description & vbCrLf & "ErrorSource: " & Err.Source
    
    Select Case (Err.Number)
        Case (3151)
            Err.Clear
            tdfLinked.Connect = "ODBC;" & BuildSQLConnectionString(Server, Database)
            GoTo Function_Continue
    
        Case (-2147467259)
            Err.Clear
            tdfLinked.Connect = "ODBC;" & BuildSQLConnectionString(Server, Database)
            GoTo Function_Continue
   
        Case (3626) 'too many indexes on source table for Access
            Err.Clear
            On Error GoTo 0
            If LinkTable(LinkedTableAlias, Server, Database, "vw" & SourceTableName, OverwriteIfExists) Then
                Debug.Print "Can't link directly to table '" + SourceTableName + "' because it contains too many indexes for Access to handle. Linked to view '" & "vw" & SourceTableName & "' instead."
                LinkTable = True
            Else
                Debug.Print "Can't link table '" + SourceTableName + "' because it contains too many indexes for Access to handle. Create a view named '" & "vw" & SourceTableName & "' that selects all rows/columns from '" & SourceTableName & "' and try again to circumvent this."
                LinkTable = False
                Exit Function
            End If
    End Select
        
Function_End:
    tdfLinked.RefreshLink
    LinkTable = True
    GoTo Function_Quit
    
Function_Quit:
    Set tdfLinked = Nothing
    
End Function

Function BuildSQLConnectionString(Server As Variant, DBName As Variant) As String
    BuildSQLConnectionString = "Driver={SQL Server};Server=" & Server & _
    ";APP=" & Application.CurrentDb.Properties("AppTitle").Value & _
    ";Database=" & DBName & ";TRUSTED_CONNECTION=yes;"
End Function

Function BuildNativeSQLConnectionString(Server As Variant, DBName As Variant) As String
    BuildNativeSQLConnectionString = "Driver={SQL Server Native Client 10.0};Server=" & Server & _
    ";APP=" & Application.CurrentDb.Properties("AppTitle").Value & _
    ";Database=" & DBName & ";TRUSTED_CONNECTION=yes;"
End Function

Function TableNameInUse(TableName As Variant) As Boolean
    'check for local tables, linked tables and queries (they all share the same namespace)
    TableNameInUse = DCount("*", "MSYSObjects", "(Type = 4 or type=1 or type=5) AND [Name]='" & TableName & "'") > 0
End Function

Function IsLinkedTable(TableName As Variant) As Boolean
    IsLinkedTable = DCount("*", "MSYSObjects", "(Type = 4) AND [Name]='" & TableName & "'") > 0
End Function

Public Function DeleteODBCTableNames(Optional stLocalTableName As String)
On Error GoTo Err_DeleteODBCTableNames

Dim dbs As Database, tdf As TableDef, i As Integer
Set dbs = CurrentDb

If Len(stLocalTableName) = 0 Then
    For i = dbs.TableDefs.Count - 1 To 0 Step -1
        Set tdf = dbs.TableDefs(i)
            If (tdf.Attributes And dbAttachedODBC) Then
                If tdf.Name = "R2IMAGE" Then
'                    Debug.Print "Skipped Table:" & vbTab & tdf.Name
                Else
'                    Debug.Print "Linked Table:" & vbTab & tdf.Name
                    dbs.TableDefs.Delete (tdf.Name)
                End If
            End If
    Next i
Else
'    Debug.Print "Local Table:  " & vbTab & stLocalTableName
    dbs.TableDefs.Delete (stLocalTableName)
End If

dbs.Close
Set dbs = Nothing

Exit_DeleteODBCTableNames:
Exit Function

Err_DeleteODBCTableNames:
MsgBox ("Error # " & Str(Err.Number) & " was generated by " & Err.Source & Chr(13) & Err.Description)
Resume Exit_DeleteODBCTableNames
End Function

Thanks

John Fuhrman

 

[jeffwest21]

Sorry, a bit more clarity.

I have a multi-user Access 2007 database, which has a main data table as well as many other tables.

Every 30 minutes I have another access database (2003) which as part of a scheduled task opens up and imports into another table all the data from my main table, this second access database is linked to a SQL table.

The main reason for doing it this way is that SQL wouldn't link to the accdb database but will to a mdb.

Because of the way the company I work for has locked down the user accounts, and the security I had to build into the database, when a user logs into the database it basically locks the database at the same time, if this happens while my process is running, or the process starts while someone is logging it it locks the database, but doesn't then recover to check again if it is ok to continue.

What I need I guess is an error trap, so that the 1/2 process if the main database is locked will try again until it is successful.

Hope that is a bit more helpful.

'Clever boy...'

 

[sparkbyte]

Do you know the error number it throws when the DB is locked?

Thanks

John Fuhrman

 

[jeffwest21]

No, all I get is an error message pop up that says something like Database is locked by #Machine Number#. It then stops working at that point. Pressing continue either locks again, or takes tyou to the VBA where it has stopped.

'Clever boy...'

 

[sparkbyte]

What about something like this. I would also add a counter so that it does not get stuck in the loop.

RunImport:
  Your import script


Err_Handler_Exit:
Exit Sub

Err_Handler:
'Debug.Print "Error # : " & Err.Number

Select Case Err.Number
    Case 5 ' Loop every ten minutes until error is cleared.  (REPLACE ERROR NUMBER WITH CORRRECT NUMBER)
          Application.Wait (Now() + "00:10:00")
          Resume RunImport
    Case Else
        If StandardErrors(Err) = False Then
           MsgBox Err & ": " & Err.Description
        End If
End Select
 
Resume Err_Handler_Exit

Thanks

John Fuhrman

 

[jeffwest21]

Cheers John, I have a few small tweaks to do geerally with the system over the next few days, so will add this and see what happens.

'Clever boy...'

 

[Andrzejek]

takes tyou to the VBA where it has stopped.

So you CAN post the code where your app stops working?

Have fun.

---- Andy

 

[jeffwest21]

So you CAN post the code where your app stops working?

Not really, as it is different every time depending on the point in the vba where the lock happens.

The main issue is that I want this to run without intervention, the process needs to run from 9am to 8pm everyday, but every so often stops because of this, it hasn't happened for a few days now, but happened three times over the weekend, I managed to dial in and fix it from home, but i can't always do this.

'Clever boy...'

 

[PHV]

sparkbyte, there is NO Application.Wait method in access ...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886