Problems opening workspaces to add tables/fields to secured access

[brandonjelinek]

i have created a database that keeps track of all my tables, fields, and
relationships i want created as my back end to the actual database i am
making for my users. The entire code works execept for when i have told it
to create a secured database file with a password. It creates the database
just fine, but it fails to open the workspace to insert the tables and such
into the secured database. When i step into the code. It does successfully
resolve the password needed and suposidly opens the workspace and runs all
the code to create the tables/fields/relationships.. but the new secured
database ends up blank. When the backend database is unsecured, it works
just fine and makes all the tables/fields/and relationships without problems.
Any ideas here?

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
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

" & " = '" & 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