-
Notifications
You must be signed in to change notification settings - Fork 1
/
Rebuilder.bas
320 lines (231 loc) · 10.6 KB
/
Rebuilder.bas
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
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
Attribute VB_Name = "Rebuilder"
Option Compare Database
Public Sub LoadObjects()
loadTables
loadModules
loadQueries
loadFormsReports "forms"
loadFormsReports "reports"
End Sub
Private Sub loadFormsReports(objType As String)
Dim fs, oFolder
Dim db As DAO.Database
Dim qDef As DAO.QueryDef
Dim sqlTxt As String, objNam As String, newFile As String
Dim objAcTyp As AcObjectType
Set fs = CreateObject("Scripting.FileSystemObject")
Set oFolder = fs.GetFolder(CurrentProject.Path & "\" & objType & "\properties")
Dim objTypeStr As String
If objType = "forms" Then
objTypeStr = "Form"
objAcTyp = acForm
Else
objTypeStr = "Report"
objAcTyp = acReport
End If
For Each aFile In oFolder.Files
objNam = Mid(aFile.NAME, 1, Len(aFile.NAME) - 4)
Debug.Print objNam
newFile = CurrentProject.Path & "\" & objType & "\" & objNam & "_combined.txt"
Dim bFile As Object
Dim cFile As Object
Set cFile = fs.CreateTextFile(newFile)
Open aFile For Input As #1
Do While Not EOF(1) ' Loop until end of file.
Line Input #1, strTextLine
cFile.writeLine strTextLine & vbCrLf
Loop
Close #1
If fs.FileExists(CurrentProject.Path & "\" & objType & "\code\" & objTypeStr & "_" & objNam & ".cls") Then
Set bFile = fs.OpenTextFile(CurrentProject.Path & "\" & objType & "\code\" & objTypeStr & "_" & objNam & ".cls")
cFile.writeLine "CodeBehindForm" & vbCrLf
cFile.writeLine bFile.readAll
Set bFile = Nothing
End If
cFile.Close
LoadFromText objAcTyp, objNam, newFile
fs.deleteFile newFile
Next aFile
Set fs = Nothing
End Sub
Private Sub loadQueries()
Dim fs, oFolder
Dim db As DAO.Database
Dim qDef As DAO.QueryDef
Dim sqlTxt As String
Set db = CurrentDb
Set fs = CreateObject("Scripting.FileSystemObject")
Set oFolder = fs.GetFolder(CurrentProject.Path & "\queries")
For Each aFile In oFolder.Files
Set qDef = New DAO.QueryDef
qDef.NAME = Mid(aFile.NAME, 1, Len(aFile.NAME) - 4)
sqlTxt = ""
Open aFile For Input As #1
Do While Not EOF(1) ' Loop until end of file.
Line Input #1, strTextLine
sqlText = sqlText & strTextLine & vbCrLf
Loop
Close #1
sqlText = Trim(sqlText)
sqlText = Left(sqlText, Len(sqlText) - 2)
qDef.sql = sqlText
db.QueryDefs.Append qDef
Set qDef = Nothing
sqlText = ""
Next aFile
End Sub
Private Sub loadModules()
Dim fs, oFolder
Set fs = CreateObject("Scripting.FileSystemObject")
Set oFolder = fs.GetFolder(CurrentProject.Path & "\modules")
For Each aFile In oFolder.Files
LoadFromText acModule, Mid(aFile.NAME, 1, Len(aFile.NAME) - 4), aFile
Next aFile
Set oFolder = fs.GetFolder(CurrentProject.Path & "\classes")
For Each aFile In oFolder.Files
DoCmd.RunCommand acCmdNewObjectClassModule
Application.ReplaceModule acModule, "Class1", aFile, 0
Next aFile
End Sub
Private Sub loadTables()
Dim fs, oFolder
Dim db As DAO.Database
Set db = CurrentDb
Set fs = CreateObject("Scripting.FileSystemObject")
Set oFolder = fs.GetFolder(CurrentProject.Path & "\tables")
For Each aFile In oFolder.Files
Debug.Print aFile.NAME
Dim tabNam As String
Dim catch As Boolean
tabNam = Mid(aFile.NAME, 1, Len(aFile.NAME) - 4)
Dim tabDef As DAO.TableDef
Dim fldDef As DAO.Field
Dim idxDef As DAO.Index
Set tabDef = New DAO.TableDef
tabDef.NAME = tabNam
Open aFile For Input As #1
Dim lineNo As Integer
lineNo = 0
Do While Not EOF(1) ' Loop until end of file.
Line Input #1, strTextLine
lineNo = lineNo + 1
'Debug.Print lineNo & " - " & strTextLine
If catch Then
Dim fldArr() As String
Dim tmpLine As String
tmpLine = Trim(strTextLine)
tmpLine = Replace(tmpLine, vbTab, "")
fldArr() = Split(tmpLine)
If UBound(fldArr) > 0 Then
Set fldDef = New DAO.Field
Dim fldNam As String
Dim fldArrIdx As Integer
Dim fldFlNamCaught As Boolean
fldNam = ""
fldFlNamCaught = False
fldArrIdx = 0
'Debug.Print UBound(fldArr)
Do While (fldArrIdx < UBound(fldArr) And Not fldFlNamCaught)
fldNam = fldNam & fldArr(fldArrIdx)
If InStr(1, fldArr(fldArrIdx), "]") > 0 Then
fldFlNamCaught = True
End If
fldArrIdx = fldArrIdx + 1
Loop
If InStr(1, fldNam, ",") > 0 Then
tmpFldNam = Replace(fldNam, ",", "")
fldNam = tmpFldNam
End If
fldDef.NAME = Replace(Replace(fldNam, "[", ""), "]", "")
Select Case fldArr(fldArrIdx)
Case "Counter"
fldDef.Type = dbLong
fldDef.Attributes = DAO.FieldAttributeEnum.dbAutoIncrField
Case "Long"
fldDef.Type = dbLong
Case "Text"
fldDef.Type = dbText
Case "YesNo"
fldDef.Type = dbBoolean
Case "Byte"
fldDef.Type = dbByte
Case "Integer"
fldDef.Type = dbInteger
Case "Currency"
fldDef.Type = dbCurrency
Case "Single"
fldDef.Type = dbSingle
Case "Double"
fldDef.Type = dbDouble
Case "DateTime"
fldDef.Type = dbDate
Case "Binary"
fldDef.Type = dbBinary
Case "OLE Object"
fldDef.Type = dbLongBinary
Case "Memo"
fldDef.Type = dbMemo
Case "Hyperlink"
fldDef.Type = dbMemo
fldDef.Attributes = DAO.FieldAttributeEnum.dbHyperlinkField
Case "GUID"
fldDef.Type = dbGUID
End Select
If UBound(fldArr) >= fldArrIdx + 1 Then
If Not fldArr(fldArrIdx + 1) = ")""" Then
fldDef.size = CInt(Replace(Replace(fldArr(fldArrIdx + 1), "(", ""), ")", ""))
End If
End If
tabDef.Fields.Append fldDef
'Debug.Print "COL: " & fldDef.Name & "|" & fldDef.Type & "|" & fldDef.Size
Set fldDef = Nothing
fldNam = ""
End If
End If
If Right(strTextLine, 1) = """" And catch Then
'Debug.Print vbTab & "End field catch"
catch = False
End If
If Left(strTextLine, 7) = """CREATE" Then
If Not Mid(strTextLine, 9, 5) = "TABLE" Then
'catch = True
Dim idxArr() As String
Dim idxArrIdx As Integer
Dim nameCaught As Boolean
nameCaught = False
idxArrIdx = 0
Set idxDef = New DAO.Index
idxArr = Split(strTextLine)
Do While idxArrIdx < UBound(idxArr)
'Debug.Print vbTab & "IDX_PARM" & vbTab & idxArr(idxArrIdx)
If idxArr(idxArrIdx) = "UNIQUE" Then
idxDef.Unique = True
ElseIf Left(idxArr(idxArrIdx), 1) = "[" And Not nameCaught Then
idxDef.NAME = Replace(Replace(idxArr(idxArrIdx), "[", ""), "]", "")
nameCaught = True
ElseIf Left(idxArr(idxArrIdx), 2) = "([" Then
idxDef.Fields = Replace(Replace(idxArr(idxArrIdx), "([", ""), "])", "")
ElseIf idxArr(idxArrIdx) = "PRIMARY" Then
idxDef.Primary = True
ElseIf idxArr(idxArrIdx) = "DISALLOW" Then
idxDef.Required = True
ElseIf idxArr(idxArrIdx) = "IGNORE" Then
idxDef.IgnoreNulls = True
End If
idxArrIdx = idxArrIdx + 1
Loop
Debug.Print "IDX: " & idxDef.NAME
tabDef.Indexes.Append idxDef
Set idxDef = Nothing
Else
catch = True
End If
End If
Loop
Close #1
db.TableDefs.Append tabDef
db.TableDefs.Refresh
Set tabDef = Nothing
'LoadFromText acTable, tabNam, aFile
Next aFile
End Sub