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
|
' Note that the [brackets] are only necessary if the table or field
' names are Access reserved words.
Private Sub cmdGo_Click()
Dim db As DAO.Database
Dim new_tabledef As DAO.TableDef
Dim new_field As DAO.Field
Dim old_field As DAO.Field
Dim new_index As DAO.Index
Dim new_relation As DAO.Relation
Dim relation_field As DAO.Field
Dim sql As String
' Open the database.
Set db = DBEngine.Workspaces(0).OpenDatabase(txtDatabase.Text, False, False)
' Remove junk from previous runs if it exists.
On Error Resume Next
db.Relations.Delete txtRelation.Text
db.TableDefs(txtNewTable.Text).Indexes.Delete "idx" & txtNewField.Text
db.TableDefs.Delete txtNewTable.Text
On Error GoTo 0
' Make the new table.
Set new_tabledef = db.CreateTableDef(txtNewTable.Text)
Set old_field = db.TableDefs(txtOldTable.Text).Fields(txtOldField.Text)
Set new_field = new_tabledef.CreateField(txtNewField.Text, old_field.Type, old_field.Size)
new_tabledef.Fields.Append new_field
db.TableDefs.Append new_tabledef
' Make the new field unique.
Set new_index = new_tabledef.CreateIndex("idx" & txtNewField.Text)
new_index.Fields.Append new_index.CreateField(txtNewField.Text)
new_index.Unique = True
new_tabledef.Indexes.Append new_index
' Copy the values into the new table.
sql = "INSERT INTO [" & _
txtNewTable.Text & "] ([" & _
txtNewField.Text & "]) " & _
"SELECT DISTINCT [" & txtOldField.Text & _
"] FROM [" & txtOldTable.Text & "]"
'Debug.Print sql
db.Execute sql
' If the relation name is non-blank, then
' make the relation between the tables.
If Len(txtRelation.Text) > 0 Then
Set new_relation = db.CreateRelation( _
txtRelation.Text, _
txtNewTable.Text, _
txtOldTable.Text)
Set relation_field = new_relation.CreateField(txtNewField.Text)
relation_field.ForeignName = txtOldField.Text
new_relation.Fields.Append relation_field
db.Relations.Append new_relation
End If
' Close the database.
db.Close
MsgBox "Done"
End Sub
Private Sub Form_Load()
Dim db_name As String
db_name = App.Path
If Right$(db_name, 1) <> "\" Then db_name = db_name & "\"
txtDatabase.Text = db_name & "People.mdb"
End Sub
Private Sub Form_Resize()
Dim wid As Single
Dim ctl As Control
wid = ScaleWidth - txtDatabase.Left
If wid < 120 Then wid = 120
For Each ctl In Me.Controls
If TypeOf ctl Is TextBox Then ctl.Width = wid
Next ctl
cmdGo.Left = (ScaleWidth - cmdGo.Width) / 2
End Sub |
