Article ID: 108148
Article Last Modified on 1/8/2003
APPLIES TO
- Microsoft Visual Basic 3.0 Professional Edition
This article was previously published under Q108148
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"
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
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
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.
Additional query words: 3.00
Keywords: KB108148