Knowledge Base

How to Delete a Field from a Populated Table

Article ID: 108148

Article Last Modified on 1/8/2003

APPLIES TO

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:

  1. Start a new project in Visual Basic. This creates Form1 by default.
  2. From the File menu, choose New Module, or click on the Toolbar icon second from the left.
  3. From the File menu, choose Add File, and add the CMDIALOG.VBX custom control to your project.
  4. 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=""
  5. Position the textbox in the vicinity of the Pickdb button, so it will display the path and filename of the database selected.
  6. Position the Label1 label over the List1 list box, and position Label2 under List2.
  7. Position Label3 over List2.
  8. 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
  9. 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
  10. 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
  11. 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
  12. 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
  13. 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
  14. 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
  18. 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
  19. Save the project.

Step-by-Step Instructions for Using the Program

  1. Press the F5 key and click the Which Database? button. Then browse for the database to modify.
  2. 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.
  3. Double-click the table names displayed in List1 to get the field names displayed in List2.
  4. 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.
  5. 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.
  6. When prompted to delete the old table, you can choose to delete, not delete, or cancel.
  7. 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


Send feedback to Microsoft

© Microsoft Corporation. All rights reserved.