Article ID: 113390
Article Last Modified on 1/8/2003
Control Property New Value
----------------------------------------------------------------------
Label1 Caption Use this method to delete a table or all the
records in a table very quickly, instead of
deleting the records one by one.
Command1 Caption Press to view the TableDefs of BIBLIO.MDB
Command2 Caption Press to Delete the selected 'newtb'
TableDef of BIBLIO.MDB
Command2 Visible False
Command3 Caption Press to Compact BIBLIO.MDB to Delete the
unwanted table's (newtb) records
Command3 Visible False
Command4 Caption Press to add an empty TableDef (newtb) back
to BIBLIO.MDB
Command4 Visible False
List1 Visible False
Sub Command1_Click ()
' List the TableDefs in BIBLIO.MDB:
Dim db As Database
Set db = OpenDatabase("BIBLIO.MDB")
For i% = 0 To db.TableDefs.Count - 1
list1.AddItem db.TableDefs(i%).Name
Next i%
db.close
list1.visible = True
End Sub
Sub List1_Click ()
command2.Visible = True
End Sub
Sub Command2_Click ()
' Delete the newtb TableDef:
Dim db As database
Set db = OpenDatabase("BIBLIO.MDB")
screen.MousePointer = 11
db.TableDefs.Delete "newtb" ' Deletes the TableDef
screen.MousePointer = 0
command3.Visible = True
End Sub
Sub Command3_Click ()
' Compact the database to get rid of the records:
Const DB_LANG_GENERAL = ";LANGID=0x0809;CP=1252;COUNTRY=0"
screen.MousePointer = 11
' Next, compact the BIBLIO.MDB database under the name
' BIBLIO2.MDB (compare sizes).
' Enter the following two lines as one, single line:
CompactDatabase "C:\VB\BIBLIO.MDB", "C:\TMP\BIBLIO2.MDB",
DB_LANG_GENERAL, 2
screen.MousePointer = 0
command4.Visible = True
End Sub
Sub Command4_Click ()
' Create a new empty newtb table:
Dim db As database
Dim newtd As New TableDef
Dim newidx As New index
Dim f1 As New field
screen.MousePointer = 11
Set db = OpenDatabase("C:\TMP\BIBLIO2.MDB")
newtd.Name = "Newtb"
f1.Name = "fld1"
f1.Type = 3 ' Integer data type
newtd.Fields.Append f1
newidx.Name = "Field1 index"
newidx.Fields = "fld1"
newidx.Primary = True
newtd.Indexes.Append newidx
db.TableDefs.Append newtd
screen.MousePointer = 0
End Sub
Additional query words: 1.00 2.00 3.00
Keywords: KB113390