|
The information in this article applies to:
- Professional Edition of Microsoft Visual Basic for Windows,
version 3.0
SUMMARY
This article shows by code example how to delete one or more fields from
an existing table.
Field definitions cannot be removed from the TableDef of the table, but
once the Field has been appended to the Fields collection, you can create a
new TableDef, minus the unwanted fields, and then copy the data from the
old table into the new table. An intermediate step uses a Microsoft Access
database as a staging area. This will work for databases other than
Microsoft Access because the Microsoft Access database is used and deleted,
with the data never having been affected by the intermediate stage.
MORE INFORMATION
Step-by-Step Instructions for Creating the Program
To create a Visual Basic utility program that allows selective field
deletions, follow these steps:
- Start a new project in Visual Basic. This creates Form1 by default.
- From the File menu, choose New Module, or click on the Toolbar icon
second from the left.
- From the File menu, choose Add File, and add the CMDIALOG.VBX custom
control to your project.
- On the form, create the following controls, and set the design-time
properties shown:
Control Name Property
--------------------------------------------------------------
Common Dialog Cmdialog1 (defaults)
Command Button Pickdb Caption="Which Database?"
Command Button Command1 Caption="Copy table minus fields"
Text Box Text1 (defaults)
List Box List1 (defaults)
List Box List2 (defaults)
Label Label1 Caption="Tables in Database"
Label Label2 Caption="Select Field(s) to Remove"
Label Label3 Caption=""
- Position the textbox in the vicinity of the Pickdb button, so it will
display the path and filename of the database selected.
- Position the Label1 label over the List1 list box, and position Label2
under List2.
- Position Label3 over List2.
- Add the following code to the form load event:
Sub Form_Load ()
' set gtempdir to an appropriate directory in the global .BAS module
On Error Resume Next
Kill gtempdir & "tempDB.mdb"
Set gdb1 = CreateDatabase(gtempdir & "tempDB.mdb", DB_LANG_GENERAL)
command1.Enabled = False
End Sub
- Add the following code to the Command1_Click event:
Sub Command1_Click ()
Dim dbsource As database
Dim dbdest As database
Set dbsource = gdb2 ' the database with table to be modified
Set dbdest = gdb1 ' the temp base
' Indexes can be compound (defined to include several fields) and
' one or more of the fields int he compound index may be deleted.
' Therefore, to simplify the copy process, no indexes are copied
' to the new table. You must make note of the indexes on the old
' table and re-create them based on the new fields by using Data
' Manager, the VISDATA sample application, or code.
Cls
currentx = 0: currenty = 0
' Place the following Print statement on one, single line:
Print DCopyStruct(dbsource, dbdest, (label3), "tempctable",
gdelfield_arr(), gdelfields_count)
Print DCopyData(dbsource, dbdest, (label3), "tempctable")
' Reset storage arrays and counters for next operation:
ReDim gdelfield_arr(1 To 1)
ReDim gfieldorder_arr(1 To 1)
gdelfields_count = 0
gfieldorder_count = 0
' Copy back from temp after deleting old table:
Set dbsource = gdb1 ' the temp base
Set dbdest = gdb2 ' the database with table to be modified
' NOTE: If the table was defined in Microsoft Access to be in a
' relationship (using primary/foreign keys) to other tables, you will
' not be able to Delete it without undoing those relationships first.
' In that case, use something like the following to create the new
' table, and place it all on one, single line:
response = MsgBox("Delete old table from database?", 3,
"Decision Time!")
Select Case response
Case 6
' If Okay, delete the old table:
gdb2.TableDefs.Delete label3
' Place the following Print statement on one, single line:
Print DCopyStruct(dbsource, dbdest, "tempctable", (label3),
gdelfield_arr(), gdelfields_count)
Print DCopyData(dbsource, dbdest, "tempctable", (label3))
Case 7
' Copy the new table with "new" appended to its name:
' Place the following Print statement on one, single line:
Print DCopyStruct(dbsource, dbdest, "tempctable",
(label3) & "new", gdelfield_arr(), gdelfields_count)
Print DCopyData(dbsource, dbdest, "tempctable", (label3) & "new")
Case 2
' Place the following MsgBox statement on one, single line:
MsgBox "Cancelling copy of the new table back to the database.",
0, "Decision Made"
End Select
Set dbsource = Nothing
Set dbdest = Nothing
gdb2.Close
command1.Enabled = False
list1.Clear
list2.Clear
End Sub
- Add the following code to the Pickdb_Click event:
Sub Pickdb_Click ()
' Reset global storage arrays and counters for next operation:
ReDim gdelfield_arr(1 To 1)
ReDim gfieldorder_arr(1 To 1)
gdelfields_count = 0
gfieldorder_count = 0
' Enter the following two lines as one, single line:
cmdialog1.Filter = "Access (*.MDB)|*.mdb|Btrieve (*.DDF)|*.ddf|dBase
(*.DBF)|*.dbf|FoxPro (*.DBF)|*.dbf|Paradox (*.DB)|*.db"
cmdialog1.Action = 1
text1 = cmdialog1.Filename ' Display the choice
prompt$ = "Type the database connect string. For Access, press ENTER"
title$ = "Connect string for OpenDatabase"
connect$ = InputBox$(prompt$, title$, "Access")
Select Case connect$
Case ""
Exit Sub
Case "Btrieve"
dbname$ = text1
Case "Access"
dbname$ = text1
connect$ = ""
Case Else
dbname$ = StripFileName((text1))
Debug.Print "else!"
End Select
' Open the database with Exclusive set to True:
Set gdb2 = OpenDatabase(dbname$, True, False, connect$)
Set gtabledefs = gdb2.TableDefs
' List the tables in list1
For i = 0 To gdb2.TableDefs.Count - 1
If (gdb2.TableDefs(i).Attributes And DB_SYSTEMOBJECT) = 0 Then
list1.AddItem gdb2.TableDefs(i)
End If
Next i
command1.Enabled = True
End Sub
- Add the following code to the Form_QueryUnload event:
Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
Debug.Print "Query unload"
gdb1.Close
' Make sure the original database is explicitly closed:
On Error Resume Next
gdb2.Close
Kill gtempdir & "tempDB.mdb"
End Sub
- Add the following code to the List1_DblClick event:
Sub List1_DblClick ()
list2.Clear
' Place the following two lines on one, single line:
For i = 0 To
gdb2.TableDefs(list1.List(list1.ListIndex)).Fields.Count - 1
' Place the following two lines on one, single line:
list2.AddItem
gdb2.TableDefs(list1.List(list1.ListIndex)).Fields(i).Name
' Display the table name of the table that has its fields
' displayed in List2:
label3 = gdb2.TableDefs(list1.List(list1.ListIndex))
Next i
End Sub
- Add the following code to the List2_DblClick event:
Sub list2_DblClick ()
' Increment the global counter of the fields to be deleted:
gdelfields_count = gdelfields_count + 1
' Increase the size of the global array holding the name of the field
' to be deleted:
ReDim Preserve gdelfield_arr(1 To gdelfields_count) As String
' Store the field name to be deleted:
gdelfield_arr(gdelfields_count) = list2.List(list2.ListIndex)
' Remove it from the list:
list2.RemoveItem list2.ListIndex
End Sub
- Add the following code to the code module's General Declarations and
merge it with the DATACONS.TXT file. Give the code module's code window
the focus, choose Load Text from the File menu. Then browse for
DATACONS.TXT at the root of the Visual Basic directory, and
choose Merge.
Global gdb1 As Database
Global gdb2 As Database
Global gtable1 As table
Global gtable2 As table
Global gtabledefs As TableDefs
Global gdelfield_arr() As String
Global gdelfields_count As Integer
Global gfieldorder_arr() As Integer
Global gfieldorder_count As Integer
' Set the following to an appropriate directory:
Global Const gtempdir = "C:\temp\"
Global Const DB_LANG_GENERAl = ";LANGID=0x0809;CP=1252;COUNTRY=0"
15. Add the following code to the code module:
' Place the following Function statement on one, single line:
Function DCopyData (from_db As Database, to_db As Database, from_nm As
String, to_nm As String) As Integer
On Error GoTo CopyErr
Dim ds1 As Dynaset, ds2 As Dynaset
Dim i As Integer, skip As Integer
Set ds1 = from_db.CreateDynaset(from_nm)
Set ds2 = to_db.CreateDynaset(to_nm)
While ds1.EOF = False
skip = False
ds2.AddNew
For i = 0 To ds1.Fields.Count - 1
For n = 1 To gfieldorder_count
If gfieldorder_arr(n) = i Then
skip = True
Exit For
End If
Next n
If Not skip Then ds2(i) = ds1(i)
Next
ds2.Update
ds1.MoveNext
Wend
DCopyData = True
GoTo CopyEnd
CopyErr:
ShowError
CopyData = False
Resume CopyEnd
CopyEnd:
End Function
16. Add the following code to the code module:
' Place the following Function statement on one, single line:
Function DCopyStruct (from_db As Database, to_db As Database,
from_nm As String, to_nm As String, delarray() As String,
delfields As Integer) As Integer
On Error GoTo CSErr
Dim i As Integer, skip As Integer
Dim tbl As New Tabledef 'table object
Dim fld As Field 'field object
Dim ind As Index 'index object
' Search to see if the table exists:
namesearch:
For i = 0 To to_db.TableDefs.Count - 1
If UCase(to_db.TableDefs(i).Name) = UCase(to_nm) Then
' Place the following two lines on one, single line:
If MsgBox(to_nm+" already exists, delete it?",
4," DCopyStruct ")=YES Then
to_db.TableDefs.Delete to_db.TableDefs(to_nm)
Else
to_nm = InputBox("Enter New Table Name:")
If to_nm = "" Then
Exit Function
Else
GoTo namesearch
End If
End If
Exit For
End If
Next
' Strip off owner if needed
If InStr(to_nm, ".") <> 0 Then
to_nm = Mid(to_nm, InStr(to_nm, ".") + 1, Len(to_nm))
End If
tbl.Name = to_nm
'create the fields
For i = 0 To from_db.TableDefs(from_nm).Fields.Count - 1
Set fld = New Field
skip = False
For n = 1 To delfields
If from_db.TableDefs(from_nm).Fields(i).Name = delarray(n) Then
' Track the field ordinal position for the DCopyData call:
gfieldorder_count = gfieldorder_count + 1
ReDim Preserve gfieldorder_arr(1 To gfieldorder_count)
gfieldorder_arr(gfieldorder_count) = i - 1
skip = True
Exit For
End If
Next n
If Not skip Then
fld.Name = from_db.TableDefs(from_nm).Fields(i).Name
fld.Type = from_db.TableDefs(from_nm).Fields(i).Type
fld.Size = from_db.TableDefs(from_nm).Fields(i).Size
fld.Attributes = from_db.TableDefs(from_nm).Fields(i).Attributes
tbl.Fields.Append fld
End If
Next
' Append the new table:
to_db.TableDefs.Append tbl
DCopyStruct = True
GoTo CSEnd
CSErr:
ShowError
DCopyStruct = False
Resume CSEnd
CSEnd:
End Function
17. Add the following code to the code module:
Sub ShowError ()
Dim s As String
Dim crlf As String
crlf = Chr(13) + Chr(10)
s = "The following Error occurred:" + crlf + crlf
' Add the error string:
s = s + Error$ + crlf
' Add the error number:
s = s + "Number: " + CStr(Err)
' Beep and show the error:
Beep
MsgBox (s)
End Sub
- Add the following code to the code module:
Function StripFileName (fname As String) As String
On Error Resume Next
Dim i As Integer
For i = Len(fname) To 1 Step -1
If Mid(fname, i, 1) = "\" Then
Exit For
End If
Next
StripFileName = Mid(fname, 1, i - 1)
End Function
- Save the project.
Step-by-Step Instructions for Using the Program
- Press the F5 key and click the Which Database? button. Then
browse for the database to modify.
- Click OK to the dialog. Then type in the correct connect string in the
Input box that follows. Press Cancel on the Input box if you don't want
to open the database.
- Double-click the table names displayed in List1 to get the field names
displayed in List2.
- Double-clicking on the fields will remove them from the list and build a
list of fields to be deleted. This will not actually affect the table's
fields.
- When you have selected all the fields to be deleted, Click the button
labeled "Copy table minus fields." This will cause a new table to be
created minus the fields in a temporary database.
- When prompted to delete the old table, you can choose to delete,
not delete, or cancel.
- If you choose not to delete the old table, a new table will be created
in the original database with "new" appended to the end.
|