How to Delete a Field from a Populated Table (108148)

MORE INFORMATION

Step-by-Step Instructions for Creating the Program

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.