Jul 12 2022 11:53 AM
' 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
Jul 13 2022 08:47 AM
Solutionyou 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
Jul 13 2022 09:05 AM
Jul 17 2022 08:45 PM
Jul 13 2022 08:47 AM
Solutionyou 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