Solved

Creating Tables and Fields using VBA into a Secured Access 2007 Database having Workspace issues

Posted on 2008-10-02
3
827 Views
Last Modified: 2013-11-27
I am having trouble creating tables and fields into a secured database that i am dymically building using VBA and a master DEV database.  This code does create the secured database just fine but doesnt build the tables and fields it should in it.  I have cleaned up the code a lot and all this code seems to be working just fine when the database is unsecured  but when it is secured it is failing to open the secured file.  As i step into the code.. it successfully sees that the BEDatabase i am opening is secured and resolves the DevToolBEDBList("Password") to the correct password.  Seems to open the workspace and database and runs through all the field code and such but doesnt actually create anything.   I am at a total loss as to why this is failing.
Option Compare Database
Function CreateDBFile()
 
'Dev Tool consists of 4 Tables, BackEnd Database Names,Tables(that belong in each BE Database), Fields(that belong in each table), Relationships (between tables).
'BackendDatabases(BE_DB_Name,Encrypted,Password,DateCreated)
'Tables(BEDatabase,Table-Name,DateCreated)
'Fields(Table,FieldName,Datatype,Fieldsize,DefaultValue,Required,AllowZeroLength)
'Relationships(BEDatabase,PrimaryTable,PrimaryField,LinkedTable,LinkedField)
 
'Dev Tool Items
Dim Path As String
Dim DevToolWorkspace As Workspace
Dim DevToolDatabase As DAO.Database
'BackendDatabases Table (Dev Tool Items)
Dim DevToolBEDBList As DAO.Recordset
'Tables Table  (Dev Tool Items)
Dim DevToolTablesList As DAO.Recordset
'Fields Table  (Dev Tool Items)
Dim DevToolFieldsList As DAO.Recordset
'Relationships Table  (Dev Tool Items)
Dim DevToolRelationshipsList As DAO.Recordset
 
'Dynamically Created Database Items
Dim BEDatabase As DAO.Database
Dim BEWorkspace As Workspace
Dim BETable As DAO.TableDef
Dim BEField As DAO.Field
 
'Standard Fields to create
Dim BEIDField As DAO.Field
Dim BETransIDField As DAO.Field
Dim BEEnteredDate As DAO.Field
Dim BEEnteredBy As DAO.Field
Dim BEModifiedDate As DAO.Field
Dim BEModifiedBy As DAO.Field
 
'Relationships to be Created
Dim BERelationship As DAO.Relation
 
        
    'Find the Path this DevTool is installed in also will be the install path for BE Databases
    Set DevToolWorkspace = CreateWorkspace("", "admin", "")
    Set DevToolDatabase = CurrentDb()
        For i = Len(DevToolDatabase.Name) To 1 Step -1
            If Mid(DevToolDatabase.Name, i, 1) = Chr(92) Then
                Path = Mid(DevToolDatabase.Name, 1, i)
        Exit For
        End If
        Next
    
         
    'Open BackendDatabases Table
    Set DevToolBEDBList = DevToolDatabase.OpenRecordset("BackendDatabases")
          
    'Create all Backend Database Files that do not already exist, Loop through BackendDatabases Table to find names of files and check for encryption/password
    Do Until DevToolBEDBList.EOF
            DbFileName = Path & DevToolBEDBList("BE_DB_Name") & ".accdb"
        'if the file doesnt exist, then use DevTool Workspace to create the BEdatabase and encrypt if necessary with single password
        If Dir(DbFileName) = "" Then
            If DevToolBEDBList("Encrypted") = False Then
                Set BEDatabase = DevToolWorkspace.CreateDatabase(DbFileName, dbLangGeneral, dbVersion120)
            Else
                Set BEDatabase = DevToolWorkspace.CreateDatabase(DbFileName, dbLangGeneral & ";pwd=" & DevToolBEDBList("Password"), dbEncrypt)
            End If
            BEDatabase.Close
        End If
        
    'If the file already existed or just was created, Reopen The database and Create Tables from the DevToolTablesList, Fields and Finally the relationships
    'Check if the database is Encryted, if it is not create a standard workspace, if it is create a workspace with the password in the BackendTables Table
    If DevToolBEDBList("Encrypted") = False Then
        Set BEWorkspace = CreateWorkspace("", "admin", "")
        Set BEDatabase = BEWorkspace.OpenDatabase(DbFileName, True, False)
    Else
        Set BEWorkspace = CreateWorkspace("", "admin", DevToolBEDBList("Password"))
        Set BEDatabase = BEWorkspace.OpenDatabase(DbFileName, True, False)
    End If
    
    'Open the Tables Table in the Dev Tool and Create Tables that belong in the currently opened BEDatabase
    Set DevToolTablesList = DevToolDatabase.OpenRecordset("SELECT * FROM Tables WHERE [BEDatabase]" & " = '" & DevToolBEDBList("BE_DB_Name") & "';")
    'Loop Through Tables and create them in the right BEDatabases
    Do Until DevToolTablesList.EOF
        Set BETable = BEDatabase.CreateTableDef(DevToolTablesList("Table-Name"))
        Set DTTL_TableName = DevToolTablesList("Table-Name")
        'If the Table Already Exists then open it, Otherwise create it.
            If TableDefs <> DTTL_TableName Then
                On Error Resume Next
                'If you need to create the table create it with the standard Fields
            
                'Create the Primary Field, Autoincr
                Set BEIDField = BETable.CreateField("ID_" & DTTL_TableName, dbLong)
                BEIDField.Attributes = BEIDField.Attributes + dbAutoIncrField
                BETable.Fields.Append BEIDField
                Set idx = BETable.CreateIndex("PrimaryKey")
                Set fldIndex = idx.CreateField("ID_" & DTTL_TableName, dbLong)
                idx.Fields.Append fldIndex
                idx.Primary = True
            
                'Create a Backup ID field for DataTransfers, Future and Past
                Set BETransIDField = BETable.CreateField("ID_Transfer_" & DTTL_TableName, dbLong)
                BETable.Fields.Append BETransIDField
            
                'Create Standard, Created/Modified Date/By
                Set BEEnteredDate = BETable.CreateField("Entered_Date", dbDate)
                BEEnteredDate.DefaultValue = "Now()"
                BETable.Fields.Append BEEnteredDate
                Set BEEnteredBy = BETable.CreateField("Entered_By", dbText)
                BETable.Fields.Append BEEnteredBy
                Set BEModifiedDate = BETable.CreateField("Modified_Date", dbDate)
                BEModifiedDate.DefaultValue = "Now()"
                BETable.Fields.Append BEModifiedDate
                Set BEModifiedBy = BETable.CreateField("Modified_By", dbText)
                BETable.Fields.Append BEModifiedBy
                BETable.Indexes.Append idx
            End If
        
        'Append the Table with the standard fields, refresh the list
        BEDatabase.TableDefs.Append BETable
        BEDatabase.TableDefs.Refresh
        
        'Find the Fields in the Fields Table and Create them in the Current Table and Currently Opened BE Database
        Set DevToolFieldsList = DevToolDatabase.OpenRecordset("SELECT * FROM Fields WHERE [Table]" & " = '" & DTTL_TableName & "';")
        Set BETable = BEDatabase.TableDefs(DTTL_TableName)
            
            'Loop through field list, create fields according to type.
            Do Until DevToolFieldsList.EOF
            
                'Use CASE due to string limitations in CreateField Method
                Select Case DevToolFieldsList("DataType")
                    Case "DbText"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbText)
                    Case "dbBigInt"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbBigInt)
                    Case "dbBinary"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbBinary)
                    Case "dbBoolean"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbBoolean)
                    Case "dbByte"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbByte)
                    Case "dbChar"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbChar)
                    Case "dbCurrency"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbCurrency)
                    Case "dbDate"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbDate)
                    Case "dbDecimal"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbDecimal)
                    Case "dbDouble"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbDouble)
                    Case "dbFloat"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbFloat)
                    Case "dbGUID"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbGUID)
                    Case "dbInteger"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbInteger)
                    Case "dbLong"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbLong)
                    Case "dbLongBinary"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbLongBinary)
                    Case "dbMemo"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbMemo)
                    Case "dbNumeric"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbNumeric)
                    Case "dbSingle"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbSingle)
                    Case "dbTime"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbTime)
                    Case "dbTimeStamp"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbTimeStamp)
                    Case "dbVarBinary"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbVarBinary)
                End Select
                    
                'Set Other Attributes of the field, not avaiable in the createField Method
                If DevToolFieldsList("FieldSize") Is Not Null Then
                    BEField.Size = DevToolFieldsList("FieldSize")
                End If
                If DevToolFieldsList("DefaultValue") Is Not Null Then
                    BEField.DefaultValue = DevToolFieldsList("DefaultValue")
                End If
                If DevToolFieldsList("Required") Is Not Null Then
                    BEField.Required = DevToolFieldsList("Required")
                End If
                If DevToolFieldsList("AllowZeroLength") Is Not Null Then
                    BEField.AllowZeroLength = DevToolFieldsList("AllowZeroLength")
                End If
                    
                'Append the New Field to the Current BETable
                On Error Resume Next
                BETable.Fields.Append BEField
            'Go to Next Field to be created and Loop
            DevToolFieldsList.MoveNext
            Loop
                    
    'Loop to the Next Table in the Table List
    DevToolTablesList.MoveNext
    Loop
        
    'Open the Relationships Table from this DevTool and Find relationships to be created
    Set DevToolRelationshipsList = DevToolDatabase.OpenRecordset("SELECT * FROM Relationships WHERE [BEDatabase]" & " = '" & DevToolBEDBList("BE_DB_Name") & "';")
    
    'If there are relationships to be created, Create them
    If DevToolRelationshipsList.RecordCount > 0 Then
        'Loop through Relatoinships Table and Create Relationships in the Target BE Database
        Do Until DevToolRelationshipsList.EOF
              'Create the relationship naming it with linked table name and linked field name, set the primary table and linked table
              Set BERelationship = BEDatabase.CreateRelation(DevToolRelationshipsList("LinkedTable") & " " & DevToolRelationshipsList("LinkedField"), DevToolRelationshipsList("PrimaryTable"), DevToolRelationshipsList("LinkedTable"), dbRelationDeleteCascade)
              
              'Create the Field tracking the primary field, and set the foreignname property of that field, append the field change
              Set BEField = BERelationship.CreateField(DevToolRelationshipsList("PrimaryField"))
              BEField.ForeignName = DevToolRelationshipsList("LinkedField")
              BERelationship.Fields.Append BEField
              
              'Append the relationship, refresh
              BEDatabase.Relations.Append BERelationship
              BEDatabase.Relations.Refresh
              
        'Move to next relationship in the DevTool Relationship Table and loop
        DevToolRelationshipsList.MoveNext
        Loop
    End If
 
    'Close the Current BE Database and Workspace
    BEDatabase.Close
    BEWorkspace.Close
    
    'Go to Next BE Database and Loop
    DevToolBEDBList.MoveNext
    On Error Resume Next
    Loop
                       
End Function

Open in new window

0
Comment
Question by:brandonjel
  • 2
3 Comments
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 22629024
Option Compare Database
option explicit             '<<<<<< add this line

Function CreateDBFile()




before running the codes, make sure it compiles,
by doing DEBUG>Compile
correct any errors that may be raised

0
 

Author Comment

by:brandonjel
ID: 22636800
OK i added option Explicit and correct the strings and such.  None of the corrects had to do with the workspace issue i am facing but was still good to do.. any more thoughts on opening workspaces and my problems?
Option Compare Database
Option Explicit
Function CreateDBFile()
 
'Dev Tool consists of 4 Tables, BackEnd Database Names,Tables(that belong in each BE Database), Fields(that belong in each table), Relationships (between tables).
'BackendDatabases(BE_DB_Name,Encrypted,Password,DateCreated)
'Tables(BEDatabase,Table-Name,DateCreated)
'Fields(Table,FieldName,Datatype,Fieldsize,DefaultValue,Required,AllowZeroLength)
'Relationships(BEDatabase,PrimaryTable,PrimaryField,LinkedTable,LinkedField)
Dim i As Integer
Dim DbFileName As String
Dim DTTL_TableName As String
 
'Dev Tool Items
Dim Path As String
Dim DevToolWorkspace As Workspace
Dim DevToolDatabase As DAO.Database
'BackendDatabases Table (Dev Tool Items)
Dim DevToolBEDBList As DAO.Recordset
'Tables Table  (Dev Tool Items)
Dim DevToolTablesList As DAO.Recordset
'Fields Table  (Dev Tool Items)
Dim DevToolFieldsList As DAO.Recordset
'Relationships Table  (Dev Tool Items)
Dim DevToolRelationshipsList As DAO.Recordset
 
'Dynamically Created Database Items
Dim BEDatabase As DAO.Database
Dim BEWorkspace As Workspace
Dim BETable As DAO.TableDef
Dim BEField As DAO.Field
 
'Standard Fields to create
Dim BEIDField As DAO.Field
Dim BEIndex As DAO.Index
Dim BEFieldIndex As DAO.Field
Dim BETransIDField As DAO.Field
Dim BEEnteredDate As DAO.Field
Dim BEEnteredBy As DAO.Field
Dim BEModifiedDate As DAO.Field
Dim BEModifiedBy As DAO.Field
 
'Relationships to be Created
Dim BERelationship As DAO.Relation
 
        
    'Find the Path this DevTool is installed in also will be the install path for BE Databases
    Set DevToolWorkspace = CreateWorkspace("", "admin", "")
    Set DevToolDatabase = CurrentDb()
        For i = Len(DevToolDatabase.Name) To 1 Step -1
            If Mid(DevToolDatabase.Name, i, 1) = Chr(92) Then
                Path = Mid(DevToolDatabase.Name, 1, i)
        Exit For
        End If
        Next
    
         
    'Open BackendDatabases Table
    Set DevToolBEDBList = DevToolDatabase.OpenRecordset("BackendDatabases")
          
    'Create all Backend Database Files that do not already exist, Loop through BackendDatabases Table to find names of files and check for encryption/password
    Do Until DevToolBEDBList.EOF
            DbFileName = Path & DevToolBEDBList("BE_DB_Name") & ".accdb"
        'if the file doesnt exist, then use DevTool Workspace to create the BEdatabase and encrypt if necessary with single password
        If Dir(DbFileName) = "" Then
            If DevToolBEDBList("Encrypted") = False Then
                Set BEDatabase = DevToolWorkspace.CreateDatabase(DbFileName, dbLangGeneral, dbVersion120)
            Else
                Set BEDatabase = DevToolWorkspace.CreateDatabase(DbFileName, dbLangGeneral & ";pwd=" & DevToolBEDBList("Password"), dbEncrypt)
            End If
            BEDatabase.Close
        End If
        
    'If the file already existed or just was created, Reopen The database and Create Tables from the DevToolTablesList, Fields and Finally the relationships
    'Check if the database is Encryted, if it is not create a standard workspace, if it is create a workspace with the password in the BackendTables Table
    If DevToolBEDBList("Encrypted") = False Then
        Set BEWorkspace = CreateWorkspace("", "admin", "")
        Set BEDatabase = BEWorkspace.OpenDatabase(DbFileName, True, False)
    Else
        Set BEWorkspace = CreateWorkspace("", "admin", DevToolBEDBList("Password"))
        Set BEDatabase = BEWorkspace.OpenDatabase(DbFileName, True, False)
    End If
    
    'Open the Tables Table in the Dev Tool and Create Tables that belong in the currently opened BEDatabase
    Set DevToolTablesList = DevToolDatabase.OpenRecordset("SELECT * FROM Tables WHERE [BEDatabase]" & " = '" & DevToolBEDBList("BE_DB_Name") & "';")
    'Loop Through Tables and create them in the right BEDatabases
    Do Until DevToolTablesList.EOF
        Set BETable = BEDatabase.CreateTableDef(DevToolTablesList("Table-Name"))
        DTTL_TableName = DevToolTablesList("Table-Name")
        'If the Table Already Exists then open it, Otherwise create it.
            'If BEDatabase.TableDefs <> DTTL_TableName Then
                On Error Resume Next
                'If you need to create the table create it with the standard Fields
            
                'Create the Primary Field, Autoincr
                Set BEIDField = BETable.CreateField("ID_" & DTTL_TableName, dbLong)
                BEIDField.Attributes = BEIDField.Attributes + dbAutoIncrField
                BETable.Fields.Append BEIDField
                Set BEIndex = BETable.CreateIndex("PrimaryKey")
                Set BEFieldIndex = BEIndex.CreateField("ID_" & DTTL_TableName, dbLong)
                BEIndex.Fields.Append BEFieldIndex
                BEIndex.Primary = True
                BETable.Indexes.Append BEIndex
                
                'Create a Backup ID field for DataTransfers, Future and Past
                Set BETransIDField = BETable.CreateField("ID_Transfer_" & DTTL_TableName, dbLong)
                BETable.Fields.Append BETransIDField
            
                'Create Standard, Created/Modified Date/By
                Set BEEnteredDate = BETable.CreateField("Entered_Date", dbDate)
                BEEnteredDate.DefaultValue = "Now()"
                BETable.Fields.Append BEEnteredDate
                Set BEEnteredBy = BETable.CreateField("Entered_By", dbText)
                BETable.Fields.Append BEEnteredBy
                Set BEModifiedDate = BETable.CreateField("Modified_Date", dbDate)
                BEModifiedDate.DefaultValue = "Now()"
                BETable.Fields.Append BEModifiedDate
                Set BEModifiedBy = BETable.CreateField("Modified_By", dbText)
                BETable.Fields.Append BEModifiedBy
                
            'End If
        
        'Append the Table with the standard fields, refresh the list
        BEDatabase.TableDefs.Append BETable
        BEDatabase.TableDefs.Refresh
        
        'Find the Fields in the Fields Table and Create them in the Current Table and Currently Opened BE Database
        Set DevToolFieldsList = DevToolDatabase.OpenRecordset("SELECT * FROM Fields WHERE [Table]" & " = '" & DTTL_TableName & "';")
        Set BETable = BEDatabase.TableDefs(DTTL_TableName)
            
            'Loop through field list, create fields according to type.
            Do Until DevToolFieldsList.EOF
            
                'Use CASE due to string limitations in CreateField Method
                Select Case DevToolFieldsList("DataType")
                    Case "DbText"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbText)
                    Case "dbBigInt"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbBigInt)
                    Case "dbBinary"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbBinary)
                    Case "dbBoolean"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbBoolean)
                    Case "dbByte"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbByte)
                    Case "dbChar"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbChar)
                    Case "dbCurrency"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbCurrency)
                    Case "dbDate"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbDate)
                    Case "dbDecimal"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbDecimal)
                    Case "dbDouble"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbDouble)
                    Case "dbFloat"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbFloat)
                    Case "dbGUID"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbGUID)
                    Case "dbInteger"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbInteger)
                    Case "dbLong"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbLong)
                    Case "dbLongBinary"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbLongBinary)
                    Case "dbMemo"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbMemo)
                    Case "dbNumeric"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbNumeric)
                    Case "dbSingle"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbSingle)
                    Case "dbTime"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbTime)
                    Case "dbTimeStamp"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbTimeStamp)
                    Case "dbVarBinary"
                        Set BEField = BETable.CreateField(DevToolFieldsList("FieldName"), dbVarBinary)
                End Select
                    
                'Set Other Attributes of the field, not avaiable in the createField Method
                If DevToolFieldsList("FieldSize") Is Not Null Then
                    BEField.Size = DevToolFieldsList("FieldSize")
                End If
                If DevToolFieldsList("DefaultValue") Is Not Null Then
                    BEField.DefaultValue = DevToolFieldsList("DefaultValue")
                End If
                If DevToolFieldsList("Required") Is Not Null Then
                    BEField.Required = DevToolFieldsList("Required")
                End If
                If DevToolFieldsList("AllowZeroLength") Is Not Null Then
                    BEField.AllowZeroLength = DevToolFieldsList("AllowZeroLength")
                End If
                    
                'Append the New Field to the Current BETable
                On Error Resume Next
                BETable.Fields.Append BEField
            'Go to Next Field to be created and Loop
            DevToolFieldsList.MoveNext
            Loop
                    
    'Loop to the Next Table in the Table List
    DevToolTablesList.MoveNext
    Loop
        
    'Open the Relationships Table from this DevTool and Find relationships to be created
    Set DevToolRelationshipsList = DevToolDatabase.OpenRecordset("SELECT * FROM Relationships WHERE [BEDatabase]" & " = '" & DevToolBEDBList("BE_DB_Name") & "';")
    
    'If there are relationships to be created, Create them
    If DevToolRelationshipsList.RecordCount > 0 Then
        'Loop through Relatoinships Table and Create Relationships in the Target BE Database
        Do Until DevToolRelationshipsList.EOF
              'Create the relationship naming it with linked table name and linked field name, set the primary table and linked table
              Set BERelationship = BEDatabase.CreateRelation(DevToolRelationshipsList("LinkedTable") & " " & DevToolRelationshipsList("LinkedField"), DevToolRelationshipsList("PrimaryTable"), DevToolRelationshipsList("LinkedTable"), dbRelationDeleteCascade)
              
              'Create the Field tracking the primary field, and set the foreignname property of that field, append the field change
              Set BEField = BERelationship.CreateField(DevToolRelationshipsList("PrimaryField"))
              BEField.ForeignName = DevToolRelationshipsList("LinkedField")
              BERelationship.Fields.Append BEField
              
              'Append the relationship, refresh
              BEDatabase.Relations.Append BERelationship
              BEDatabase.Relations.Refresh
              
        'Move to next relationship in the DevTool Relationship Table and loop
        DevToolRelationshipsList.MoveNext
        Loop
    End If
 
    'Close the Current BE Database and Workspace
    BEDatabase.Close
    BEWorkspace.Close
    
    'Go to Next BE Database and Loop
    DevToolBEDBList.MoveNext
    On Error Resume Next
    Loop
                       
End Function

Open in new window

0
 

Accepted Solution

by:
brandonjel earned 0 total points
ID: 22645086
Well found my solution... The problem is access 2007 does not support creating multiple workspaces but it does support opening multiple databases in the default workspace.. so i solved the issue by changing BEWorkspace to just be DBEngine.Workspaces(0).. used the BEWorkspace to open both the dev db and the other secured and unsecured databases, and put the password in the opendatabase  area...  
     Set BEWorkspace = DBEngine.Workspaces(0)  
 
 If DevToolBEDBList("Encrypted") = False Then
        Set BEDatabase = BEWorkspace.OpenDatabase(DbFileName, True, False)
    Else
        Set BEDatabase = BEWorkspace.OpenDatabase(DbFileName, True, False, "MS Access;pwd=" & DevToolBEDBList("Password"))
    End If

Open in new window

0

Featured Post

Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The first two articles in this short series — Using a Criteria Form to Filter Records (http://www.experts-exchange.com/A_6069.html) and Building a Custom Filter (http://www.experts-exchange.com/A_6070.html) — discuss in some detail how a form can be…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

820 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question