SOLVED

Split database, password-protected BE, creates err 3011 when using DoCmd.TransferDatabase

Copper Contributor
I have a front end (FE) and a back end (BE) split Access DB. The BE DB is password protected. I want to programmatically create a table in the BE, but also need to link the FE to it. I am able to create tables in the FE and BE without issue, but when I try to link them using:

DoCmd.TransferDatabase(acLink, "Microsoft Access", dbFilename, acTable, sTableName, sTableName)
 
I get the following error:
 
Error #:    3011
Message:    The Microsoft Access database engine could not find the object '[tblLoginSessions]'. Make sure the object exists and that you spell its name and the path name correctly. If '[tblLoginSessions]' is not a local object, check your network connection or contact the server administrator.
 
I have searched high and low, but most examples have to do with acImport of tables and data. I am creating table(s) and linking them using acLink.
 
From one internet suggestion, I have removed the password, made the same call and still the same error. I am able to reset the password back to the original on the BE.
 
If I don't have the code for password changing, I do get a password entry dialog, but the same error occurs. Same error, if I don't create the FE table. Currently in my code, the table is created successfully in both the FE and BE DBs, just DoCmd.TransferDatabase fails.
 
I have been unable to find a solution for linking a password-protected BE DB anywhere on the internet. Any help would be greatly appreciated. Code below. Hopefully, I included all that is needed!
 
TIA ... Sunny

 

 

' The main calling function.
Public Sub CallingFunc()
    On Error GoTo errHandler
    
    Dim sSQL As String
    Dim sBEDBPassword as String

    ' Removed code here to call a form to enter the DB password as I don't want to store it anywhere.
    sBEDBPassword = "MyCurrentPassword"
    If (sBEDBPassword <> "") Then
        ' Create table tblLoginSessions
        sSQL = "CREATE TABLE [tblLoginSessions] ([RecID] COUNTER NOT NULL, [TimeStamp] DATETIME NOT NULL , [LoginID] VARCHAR(255) NOT NULL , [Username] VARCHAR(255) NOT NULL , [Location] VARCHAR(255) NOT NULL , [UniqueBrowserId] VARCHAR(255) NOT NULL)"
        Debug.Print (sSQL)
        If (0 <> BackEndDBCreateAndLinkTable(sSQL, TBL_LOGIN_SESSIONS, sBEDBPassword)) Then GoTo exitFunc
    End If
    
exitFunc:
    Exit Sub

errHandler:
    Call ShowDBError("CallingFunc", , 49)
    Resume exitFunc
End Sub

' This function does the table creation and linking.
Public Function BackEndDBCreateAndLinkTable(sSQL As String, sTableName As String, sPassword As String) As Integer
    On Error GoTo errHandlerDBCreate
    Dim nResult As Integer
    Dim dbFilename As String
    Dim db As DAO.Database
    
    ' First create the table in FE DB.
    nResult = 0
    dbFilename = "C:\PTS_Data\PTS_7.accdb"  ' Hardcoded for demo.
    Set db = OpenDatabase(dbFilename, False, False, "MS Access;")
    Call db.Execute(sSQL, dbFailOnError)
    db.Close
    
    ' Then create the table in BE DB.
    dbFilename = dbFilename = "C:\PTS_Data\PTS_7_BE.accdb" ' Hardcoded for demo.
    Set db = OpenDatabase(dbFilename, False, False, "MS Access;PWD=" & sPassword)
    Call db.Execute(sSQL, dbFailOnError)
    db.Close
        
    ' Link the table to the BE DB.
    On Error GoTo errHandlerDBLink
    
    ' First remove the password. This section can be commented out.
    Set db = OpenDatabase(dbFilename, True, False, "MS Access;PWD=" & sPassword)
    Call db.NewPassword(sPassword, "")
    db.Close
    
    ' Create the link using TransferDatabase; couple of iterations. Both cause an error in the next line of code.
    'Call DoCmd.TransferDatabase(TransferType:=acLink, DatabaseType:="Microsoft Access", DatabaseName:=dbFilename, Source:=sTableName, Destination:=sTableName, StructureOnly:=False)
    Call DoCmd.TransferDatabase(acLink, "Microsoft Access", dbFilename, acTable, sTableName, sTableName)

exitWithPasswordReset:
    ' Then, reset the original password whether you succeed or fail. This section can be commented out.
    Set db = OpenDatabase(dbFilename, True, False, "MS Access;PWD=")
    Call db.NewPassword("", sPassword)
    db.Close

exitFunc:
    BackEndDBCreateAndLinkTable = nResult
    Exit Function

errHandlerDBCreate:
    nResult = ShowDBError("An error occurred CREATING table " & sTableName & " in BackEndDBCreateAndLinkTable() using:" & vbNewLine & vbNewLine & sSQL)
    Resume exitFunc

errHandlerDBLink:
    nResult = ShowDBError("An error occurred LINKING table " & sTableName & " in BackEndDBCreateAndLinkTable():")
    If (nResult = 3011) Then Resume exitWithPasswordReset Else: Resume exitFunc
End Function

' Just my custom helper function.
Public Function ShowDBError(Optional ByRef sMsg As String = "An error occurred:", Optional ByRef sTitle As String = PTS_TITLE_ERROR, Optional ByVal nErrIgnore As Long) As Long
    ShowDBError = 0
    If ((Err.Number <> 0) And (Err.Number <> nErrIgnore)) Then
        Call MsgBox(sMsg & vbCrLf & vbCrLf & GetErrorStr, vbCritical, sTitle)
        ShowDBError = Err.Number
        Debug.Print (sMsg & vbCrLf & vbCrLf & GetErrorStr)
    End If
    Err.Clear
End Function

 

 

 

3 Replies
best response confirmed by ITCEIAV (Copper Contributor)
Solution

@ITCEIAV 

you can create this Sub to create the Linked table.

after you create the New table in the BE, call it:

 

Call RelinkTable("BE path + name", "theTableToLink", "NewLinkNameToCreate", "passwordOfdbhere")

 

' arnelgp
Public Sub RelinkTable(ByVal DbPath As String, ByVal TableName As String, Optional ByVal LinkName As String, Optional ByVal dbPassword As String = "")
'
' dbPath        = fullpath of the database (BE) to link
' TableName     = name of table to Link
' LinkName      = the new link tablename to create. if not supplied, TableName will be used.
' dbPassword    = the password for the BE (if password protected).
'
    Dim db As dao.Database
    Dim td As dao.TableDef
    
    If Len(LinkName) < 1 Then
        LinkName = TableName
    End If
    
    Set db = CurrentDb
    Set td = Nothing
    If DCount("1", "MsysObjects", "Name = '" & LinkName & "' And Type = 6") > 0 Then
        db.TableDefs.Delete LinkName
    End If
    Set td = db.CreateTableDef(LinkName)
    td.SourceTableName = TableName
    td.Connect = "MS Access;PWD=" & dbPassword & ";DATABASE=" & DbPath
    db.TableDefs.Append td
    
    db.TableDefs.Refresh
    Application.RefreshDatabaseWindow
    Set td = Nothing
    Set db = Nothing
End Sub

 

 

 

 

@arnel_gp, I implemented this and it worked. It failed at first, but I removed the brackets that I have been using for 16 years around table names and it worked. I will experiment and see if that makes a difference. Maybe there is an anomaly?! Thank you again, MS! 🤷‍:male_sign:

For some reason it says the DB is left in an unusual state. Will post the error here, but I have to get to an appointment in a few mins.

Thank you very much for this solution!
I verified that you cannot use brackets around the TableName and LinkName in the DB calls, only in SQL statements. No errors with a DB with password and one without password.

Thank you very much for the solution @arnel_gp!
1 best response

Accepted Solutions
best response confirmed by ITCEIAV (Copper Contributor)
Solution

@ITCEIAV 

you can create this Sub to create the Linked table.

after you create the New table in the BE, call it:

 

Call RelinkTable("BE path + name", "theTableToLink", "NewLinkNameToCreate", "passwordOfdbhere")

 

' arnelgp
Public Sub RelinkTable(ByVal DbPath As String, ByVal TableName As String, Optional ByVal LinkName As String, Optional ByVal dbPassword As String = "")
'
' dbPath        = fullpath of the database (BE) to link
' TableName     = name of table to Link
' LinkName      = the new link tablename to create. if not supplied, TableName will be used.
' dbPassword    = the password for the BE (if password protected).
'
    Dim db As dao.Database
    Dim td As dao.TableDef
    
    If Len(LinkName) < 1 Then
        LinkName = TableName
    End If
    
    Set db = CurrentDb
    Set td = Nothing
    If DCount("1", "MsysObjects", "Name = '" & LinkName & "' And Type = 6") > 0 Then
        db.TableDefs.Delete LinkName
    End If
    Set td = db.CreateTableDef(LinkName)
    td.SourceTableName = TableName
    td.Connect = "MS Access;PWD=" & dbPassword & ";DATABASE=" & DbPath
    db.TableDefs.Append td
    
    db.TableDefs.Refresh
    Application.RefreshDatabaseWindow
    Set td = Nothing
    Set db = Nothing
End Sub

 

 

 

 

View solution in original post