abenitez77
Registered User.
- Local time
- Today, 15:11
- Joined
- Apr 29, 2010
- Messages
- 141
I have 2 functions which i use to gather and store table and field names in my msaccess app. I have several sql linked tables and I also go to get the table and field names for those as well. I want to get the type and size/precision of my fields and I don't want to pull up the SQL systems tables. In my function it pulls up tables I don't want, I only want user defined tables. How can i do this?
code:
Sub GetField2Description()
'**********************************************************
'Purpose: 1) Deletes and recreates a table (tblFields)
' 2) Queries table MSysObjects to return names of
' all tables in the database
' 3) Populates tblFields
'Coded by: raskew
'Inputs: From debug window:
' Call GetField2Description
'Output: See tblFields
'**********************************************************
Dim db As Database, td As TableDef
Dim rs As Recordset, rs2 As Recordset
Dim Test As String, NameHold As String
Dim typehold As String, SizeHold As String
Dim fielddescription As String, tName As String
Dim n As Long, i As Long
Dim fld As Field, strSQL As String
n = 0
Set db = CurrentDb
' Trap for any errors.
On Error Resume Next
tName = "tblFields"
'Does table "tblFields" exist? If true, delete it;
DoCmd.SetWarnings False
DoCmd.DeleteObject acTable, "tblFields"
DoCmd.SetWarnings True
'End If
'Create new tblTable
db.Execute "CREATE TABLE tblFields(TableLoc TEXT (10), Object TEXT (55), FieldName TEXT (55), FieldType TEXT (20), FieldSize Long, FieldSizeSQL TEXT (20), FieldAttributes Long, FldDescription TEXT (20));"
strSQL = "SELECT MSysObjects.Name, MSysObjects.Type From MsysObjects WHERE"
strSQL = strSQL + "((MSysObjects.Type)=1)"
strSQL = strSQL + "ORDER BY MSysObjects.Name;"
Set rs = db.OpenRecordset(strSQL)
If Not rs.BOF Then
' Get number of records in recordset
rs.MoveLast
n = rs.RecordCount
rs.MoveFirst
End If
Set rs2 = db.OpenRecordset("tblFields")
For i = 0 To n - 1
fielddescription = " "
Set td = db.TableDefs(i)
'Skip over any MSys objects
If Left(rs!Name, 4) <> "MSys" And Left(rs!Name, 1) <> "~" Then
NameHold = rs!Name
On Error Resume Next
For Each fld In td.Fields
fielddescription = fld.Name
typehold = FieldType(fld.Type)
SizeHold = fld.Size
rs2.AddNew
rs2!TableLoc = "MSACCESS"
rs2!Object = NameHold
rs2!FieldName = fielddescription
rs2!FieldType = typehold
rs2!FieldSize = SizeHold
rs2!FieldAttributes = fld.Attributes
rs2!FldDescription = fld.Properties("description")
rs2.Update
Next fld
Resume Next
End If
rs.MoveNext
Next i
rs.Close
rs2.Close
db.Close
End Sub
Sub ListTablesADOX()
Dim db As Database, td As TableDef
Dim rs As Recordset, rs2 As Recordset
Dim Catalog As New ADOX.Catalog
Dim Table As ADOX.Table, Column As ADOX.Column
Dim Conn As New ADODB.Connection
'Dim prp As ADOX.Property
Set db = CurrentDb
' Trap for any errors.
'On Error Resume Next
Set rs2 = db.OpenRecordset("tblFields")
'Open connection you want To get database objects
Conn.Provider = "MSDASQL"
Conn.Open "DRIVER=SQL Server;SERVER=USATL02PRSQ70;DATABASE=KROGER_2010_AP;Trusted_Connection=Yes"
'Get All Database tables
Set TablesSchema = Conn.OpenSchema(adSchemaTables)
'Create catalog object
Set Catalog.ActiveConnection = Conn
'List tables And columns
For Each Table In Catalog.Tables
For Each Column In Table.Columns
rs2.AddNew
rs2!TableLoc = "SQLSERVER"
rs2!Object = Table.Name
rs2!FieldName = Column.Name
rs2!FieldType = Column.Type
rs2!FieldSizeSQL = Trim(Str(Column.Precision)) & ", " & Trim(Str(Column.NumericScale)) 'Column.DefinedSize
rs2!FieldAttributes = Column.Attributes
'rs2!FldDescription = fld.Properties("description")
rs2.Update
'MsgBox Table.Name & " : " & Table.Type & " : "
'MsgBox Column.Name & " : " & Column.NumericScale & " : " & Column.Precision & " : " & Column.Type & " - " & Column
'For Each prp In Column.Properties
' MsgBox prp.Name & " - " & prp.Type & " - " & prp.Value
'Next
' Debug.Print Table.Name & ", " & Column.Name
Next
Next
rs2.Close
db.Close
End Sub
code:
Sub GetField2Description()
'**********************************************************
'Purpose: 1) Deletes and recreates a table (tblFields)
' 2) Queries table MSysObjects to return names of
' all tables in the database
' 3) Populates tblFields
'Coded by: raskew
'Inputs: From debug window:
' Call GetField2Description
'Output: See tblFields
'**********************************************************
Dim db As Database, td As TableDef
Dim rs As Recordset, rs2 As Recordset
Dim Test As String, NameHold As String
Dim typehold As String, SizeHold As String
Dim fielddescription As String, tName As String
Dim n As Long, i As Long
Dim fld As Field, strSQL As String
n = 0
Set db = CurrentDb
' Trap for any errors.
On Error Resume Next
tName = "tblFields"
'Does table "tblFields" exist? If true, delete it;
DoCmd.SetWarnings False
DoCmd.DeleteObject acTable, "tblFields"
DoCmd.SetWarnings True
'End If
'Create new tblTable
db.Execute "CREATE TABLE tblFields(TableLoc TEXT (10), Object TEXT (55), FieldName TEXT (55), FieldType TEXT (20), FieldSize Long, FieldSizeSQL TEXT (20), FieldAttributes Long, FldDescription TEXT (20));"
strSQL = "SELECT MSysObjects.Name, MSysObjects.Type From MsysObjects WHERE"
strSQL = strSQL + "((MSysObjects.Type)=1)"
strSQL = strSQL + "ORDER BY MSysObjects.Name;"
Set rs = db.OpenRecordset(strSQL)
If Not rs.BOF Then
' Get number of records in recordset
rs.MoveLast
n = rs.RecordCount
rs.MoveFirst
End If
Set rs2 = db.OpenRecordset("tblFields")
For i = 0 To n - 1
fielddescription = " "
Set td = db.TableDefs(i)
'Skip over any MSys objects
If Left(rs!Name, 4) <> "MSys" And Left(rs!Name, 1) <> "~" Then
NameHold = rs!Name
On Error Resume Next
For Each fld In td.Fields
fielddescription = fld.Name
typehold = FieldType(fld.Type)
SizeHold = fld.Size
rs2.AddNew
rs2!TableLoc = "MSACCESS"
rs2!Object = NameHold
rs2!FieldName = fielddescription
rs2!FieldType = typehold
rs2!FieldSize = SizeHold
rs2!FieldAttributes = fld.Attributes
rs2!FldDescription = fld.Properties("description")
rs2.Update
Next fld
Resume Next
End If
rs.MoveNext
Next i
rs.Close
rs2.Close
db.Close
End Sub
Sub ListTablesADOX()
Dim db As Database, td As TableDef
Dim rs As Recordset, rs2 As Recordset
Dim Catalog As New ADOX.Catalog
Dim Table As ADOX.Table, Column As ADOX.Column
Dim Conn As New ADODB.Connection
'Dim prp As ADOX.Property
Set db = CurrentDb
' Trap for any errors.
'On Error Resume Next
Set rs2 = db.OpenRecordset("tblFields")
'Open connection you want To get database objects
Conn.Provider = "MSDASQL"
Conn.Open "DRIVER=SQL Server;SERVER=USATL02PRSQ70;DATABASE=KROGER_2010_AP;Trusted_Connection=Yes"
'Get All Database tables
Set TablesSchema = Conn.OpenSchema(adSchemaTables)
'Create catalog object
Set Catalog.ActiveConnection = Conn
'List tables And columns
For Each Table In Catalog.Tables
For Each Column In Table.Columns
rs2.AddNew
rs2!TableLoc = "SQLSERVER"
rs2!Object = Table.Name
rs2!FieldName = Column.Name
rs2!FieldType = Column.Type
rs2!FieldSizeSQL = Trim(Str(Column.Precision)) & ", " & Trim(Str(Column.NumericScale)) 'Column.DefinedSize
rs2!FieldAttributes = Column.Attributes
'rs2!FldDescription = fld.Properties("description")
rs2.Update
'MsgBox Table.Name & " : " & Table.Type & " : "
'MsgBox Column.Name & " : " & Column.NumericScale & " : " & Column.Precision & " : " & Column.Type & " - " & Column
'For Each prp In Column.Properties
' MsgBox prp.Name & " - " & prp.Type & " - " & prp.Value
'Next
' Debug.Print Table.Name & ", " & Column.Name
Next
Next
rs2.Close
db.Close
End Sub