Option Explicit Dim db As database Sub Combo1_Click () Dim c As String c = combo1.Text c = Left$(c, InStr(c, ",") - 1) file1.Pattern = c file1.Refresh End Sub Sub Command2_Click () Unload form1 End End Sub Sub Dir1_Change () file1.Path = dir1.Path End Sub Sub Drive1_Change () dir1.Path = drive1.Drive End Sub Function FieldType (nFT As Integer, nDB As Integer) As String ' nFt is numeric field type ' nDB is numeric database type ' returns field typa as string Dim c As String c = "undefined" Select Case nDB Case 1 ' access/vb Select Case nFT Case DB_BOOLEAN c = "boolean" Case DB_BYTE c = "byte" Case DB_INTEGER c = "integer" Case DB_LONG c = "long" Case DB_CURRENCY c = "currency" Case DB_SINGLE c = "single" Case DB_DOUBLE c = "double" Case DB_DATE c = "date" Case DB_TEXT c = "text" Case DB_LONGBINARY c = "binary" Case DB_MEMO c = "memo" End Select 'Case 2 ' dbase End Select FieldType = c End Function Sub File1_DblClick () Dim c As String c = dir1.Path + "\" c = c + file1.List(file1.ListIndex) ' fill the outline with tables and fields FillOutline c command1.Enabled = True End Sub Sub File1_PathChange () outline1.Clear command1.Enabled = False End Sub Sub File1_PatternChange () outline1.Clear command1.Enabled = False End Sub Sub FillOutline (cDB As String) Dim n1 As Integer Dim n2 As Integer Dim n3 As Integer Dim n4 As Integer Dim n5 As Integer Dim nC As Integer Dim nAttr As Long Dim nType As Integer Dim nSize As Integer Dim c1 As String Dim c2 As String ' open db Set db = OpenDatabase(cDB, False, True) ' get number of tables in db n2 = db.TableDefs.Count nC = 0 ' clear outline outline1.Clear ' add db title to outline outline1.AddItem file1.List(file1.ListIndex), 0 ' go through list of tables For n1 = 0 To n2 - 1 ' get table name and attribs c1 = db.TableDefs(n1).Name nAttr = db.TableDefs(n1).Attributes ' if isn't system db... If nAttr And DB_SYSTEMOBJECT Then Else ' then add to outline using -1 to place at indent 1 outline1.AddItem c1, -1 ' save location nC = outline1.ListCount - 1 ' set location so following additions will be at right level outline1.ListIndex = nC ' get field count for table n4 = db.TableDefs(n1).Fields.Count For n3 = 0 To n4 - 1 nType = db.TableDefs(n1).Fields(n3).Type nSize = db.TableDefs(n1).Fields(n3).Size c2 = db.TableDefs(n1).Fields(n3).Name c2 = c2 + ", " + FieldType(nType, 1) + Str$(nSize) outline1.AddItem c2 Next n3 End If Next n1 db.Close End Sub Sub Form_Load () Dim c As String combo1.AddItem "*.mdb, Access\VB" combo1.AddItem "*.dbf, xBase" combo1.AddItem "*.*, all files" combo1.ListIndex = 0 c = combo1.List(combo1.ListIndex) c = Left$(c, InStr(c, ",") - 1) file1.Pattern = c End Sub Sub Outline1_DblClick () If outline1.Expand(outline1.ListIndex) Then outline1.Expand(outline1.ListIndex) = False Else outline1.Expand(outline1.ListIndex) = True End If End Sub