How Open Database to search for a table using vba to display its data properties.

[sunnyluthra1]

Hi Everyone,
I am working on a piece of code, that displays the properties(Name, Datatype, size & Description) of the table in the database.
Now I want to further Enhance the code.
I Have created a form in MS Access, on that form, I have 2 buttons & a text box.
One button is to select a mdb file, whom properties i want to display. Second button then stores that properties in a Excel file.
when I open the file using first button, the path of the file gets stored in the TextBox. Now what i want is that second button that generates the properties to take that path & open that database. But I couldn't able to link that path in the text box to open that database connection.

The code for both buttons is like this:
*********************************

Option Compare Database
 
Private Sub Command0_Click()
Dim mesPath, mestab, messec As String
 
messec = ""
Call CreateSchemaFile("\\ohsstor2\home\sluthra\My Documents\schemas\")
End Sub
 
Private Sub Command6_Click()
Dim AccessPath As String
AccessPath = BrowseForfile("C:\", "MS Access Files (.mdb)|*.mdb")
Text4.Value = AccessPath
    If AccessPath = "" Then: MsgBox "No path provided - stopping": Exit Sub
End Sub
 
Private Function CreateSchemaFile(sPath As String)
 
Dim Msg As String ' For error handling.
On Error GoTo Err_ShowDescrip
   Dim ws As Workspace, db As DAO.Database
   Dim tblDef As DAO.TableDef, fldDef As DAO.Field
   Dim i As Integer, Handle As Integer
   Dim fldName As String, fldDataInfo As String
   Dim dbpath As String
 
 
 
 
   ' -----------------------------------------------
   ' Set DAO objects.
   ' -----------------------------------------------
    dbpath = "Text4.value"
    szConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath & "; "
    SQL1 = "Select * from NADB;"
    Set rst = CreateObject("ADODB.Recordset")
    rst.Open SQL1, szConnStr, 1, 3
    'Set db = CurrentDb()
   ' -----------------------------------------------
   ' Open schema file for append.
   ' -----------------------------------------------
 
    sPath = "\\ohsstor2\home\sluthra\My Documents\schemas\"
    sTblQryName = "NADB"
    sSectionName = sTblQryName
    bIncFldNames = True
 
   fname = "schema_" & sTblQryName & ".ini"
 
   Handle = FreeFile
   Open sPath & "schema_" & sTblQryName & ".xls" For Output Access Write As #Handle
   ' -----------------------------------------------
   ' Write schema header.
   ' -----------------------------------------------
   Print #Handle, "Table : "; sSectionName
   'Print #Handle, "ColNameHeader = " & IIf(bIncFldNames, "True", "False")
   Print #Handle, "Created BY : SUNNY LUTHRA"
   Print #Handle, "Date : "; Now
   Print #Handle, "" & "Column Name" & Chr(9) & "Data Type" & Chr(9) & "Size" & Chr(9) & "Description"
   ' -----------------------------------------------
   ' Get data concerning schema file.
   ' -----------------------------------------------
      Set tblDef = db.TableDefs(sTblQryName)
   With tblDef
      For i = 0 To .Fields.Count - 1
         Set fldDef = .Fields(i)
         With fldDef
            fldName = .Name
            Select Case .Type
               Case dbBoolean
                  fldDataInfo = "Bit" & Chr(9)
               Case dbByte
                  fldDataInfo = "Byte" & Chr(9)
               Case dbInteger
                  fldDataInfo = "Short" & Chr(9)
               Case dbLong
                  fldDataInfo = "Integer" & Chr(9)
               Case dbCurrency
                  fldDataInfo = "Currency" & Chr(9)
               Case dbSingle
                  fldDataInfo = "Single" & Chr(9)
               Case dbDouble
                  fldDataInfo = "Double" & Chr(9)
               Case dbDate
                  fldDataInfo = "Date" & Chr(9)
               Case dbText
                  fldDataInfo = "Char " & Chr(9) & Format$(.Size)
               Case dbLongBinary
                  fldDataInfo = "OLE" & Chr(9)
               Case dbMemo
                  fldDataInfo = "LongChar" & Chr(9)
               Case dbGUID
                  fldDataInfo = "Char" & Chr(9) & "16"
            End Select
           flddescrip = .Properties("Description")
 
            Print #Handle, "" & fldName & _
                             Chr(9) & fldDataInfo & Chr(9) & flddescrip
         End With
               Next i
   End With
   MsgBox sPath & fname & " has been created."
   CreateSchemaFile = True
CreateSchemaFile_End:
   Close Handle
Exit_ShowDescrip:
Exit Function
Err_ShowDescrip:
If Err = 3270 Then
flddescrip = ""
Resume Next
Else
MsgBox (Err & ": " & Error$), , "ShowDescrip()"
End If
End Function
 
 
 
Private Function BrowseForfile(pstrPath, pstrFilter)
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = pstrFilter
objDialog.InitialDir = pstrPath
objDialog.Flags = &H80000 + &H4 + &H8
intResult = objDialog.ShowOpen
BrowseForfile = objDialog.FileName
 
            If intResult = 0 Then
            MsgBox "No file selected - Exiting"
            End If
End Function
 

**********************************
Can Anyone Knows How to set the database path here:
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath & "; "
So that instead of defining the path of data source.
Data Source should automatically takes the value in the text box or the file I open using file dialog box.
Or Anyone Having working code for opening an mdb file & displaying the properties of the tables. & then stores it in Excel file.

[JKing]

Hi there,

Could you not just alter your CreateSchemaFile Function to take both an spath and a dpath. This way when you call the function you can pass in the returned value of BrowseForFile as the dpath.

Jking