Access Tables Module

[dodge20]

I am new to Visual Basic, and I found this module that is supposed to output an Access Table info, but it doesn't output anything. Please take a look, to see if you can find the error.

Option Compare Database
Option Explicit
Sub sdaGetAttributes()
'* Extracts documentation data on
' table attributes to USYStblDoc
On Error GoTo sdaGetAttributes_Err

Dim WS As Workspace
Dim DB As Database
Dim TD As TableDef
Dim RSOut As DAO.Recordset
Dim RSIn As DAO.Recordset

Dim lngI As Long
Dim lngK As Long
Dim ysnRunSpecProc As Boolean

'* Uncomment next line to run sidebar example
'ysnRunSpecProc = True

Call DelTblData("USystblDoc&quot
Set WS = DBEngine.Workspaces(0)
Set DB = WS.Databases(0)

Set RSOut = _
DB.OpenRecordset("USystblDoc", dbOpenDynaset)

WS.BeginTrans
With DB
For Each TD In .TableDefs
If Left(TD.Name, 3) = "tbl" Then
Set RSIn = _
.OpenRecordset(TD.Name, dbOpenTable)
For lngI = 0 To RSIn.Fields.Count - 1
RSOut.AddNew
RSOut("TableName&quot = RSIn.Name
RSOut("FieldName&quot = _
RSIn.Fields(lngI).Name
RSOut("FieldType&quot = _
GetType(RSIn.Fields(lngI).Type)
RSOut("FieldSize&quot = _
CStr(RSIn.Fields(lngI).Size)
RSOut("FieldReqd&quot = _
RSIn.Fields(lngI).Required
RSOut("FieldDflt&quot = _
RSIn.Fields(lngI).DefaultValue
On Error Resume Next
'* The following Property is not
' available when Descr is Null
RSOut("FieldDescr&quot = _
RSIn.Fields(lngI).Properties _
("Description&quot
On Error GoTo sdaGetAttributes_Err
'* The sidebar code is below:
If ysnRunSpecProc Then
For lngK = 0 To RSIn.Fields _
(lngI).Properties.Count - 1
Debug.Print lngK, RSIn.Fields _
(lngI).Properties(lngK).Name
Next lngK
ysnRunSpecProc = False
End If
RSOut.Update
Next lngI
RSIn.Close
End If
Next TD
End With
WS.CommitTrans

RSOut.Close

sdaGetAttributes_Exit:
WS.Rollback
On Error GoTo 0
Set RSIn = Nothing
Set RSOut = Nothing
Set TD = Nothing
Set DB = Nothing
Set WS = Nothing
Exit Sub

sdaGetAttributes_Err:
Select Case Err
'* RollBack without BeginTrans,
' Object variable not set
Case 3034, 91
Resume Next
Case Else
MsgBox Err & "> " & Error & _
" (sdaGetAttributes/basDocumenter"
End Select
Resume sdaGetAttributes_Exit

End Sub
Private Function GetType(lType As Long) As String
'* Returns description of lType
Select Case lType
Case dbBigInt: GetType = "BigInt"
Case dbBinary: GetType = "Binary"
Case dbBoolean: GetType = "Boolean"
Case dbByte: GetType = "Byte"
Case dbChar: GetType = "Char"
Case dbCurrency: GetType = "Currency"
Case dbDate: GetType = "Date"
Case dbDecimal: GetType = "Decimal"
Case dbDouble: GetType = "Double"
Case dbFloat: GetType = "Float"
Case dbGUID: GetType = "GUID"
Case dbInteger: GetType = "Integer"
Case dbLong: GetType = "Long"
Case dbLongBinary: GetType = "LongBinary"
Case dbMemo: GetType = "Memo"
Case dbNumeric: GetType = "Numeric"
Case dbSingle: GetType = "Single"
Case dbText: GetType = "Text"
Case dbTime: GetType = "Time"
Case dbTimeStamp: GetType = "TimeStamp"
Case dbVarBinary: GetType = "VarBinary"
Case Else: GetType = "Undefined"
End Select
End Function
Private Function DelTblData(strName As String) _
As Boolean
'* Clears data from table name argument

Dim DB As Database
Dim QD As QueryDef

Dim strSQL As String

Set DB = CurrentDb
Set QD = DB.CreateQueryDef("&quot

strSQL = "DELETE " & strName & ".* "
strSQL = strSQL & "FROM " & strName & ";"
QD.SQL = strSQL
QD.Execute (DB_FAILONERROR)

DelTblData = True

DeleteTableData_Exit:
Set QD = Nothing
Set DB = Nothing
Exit Function

End Function


And the query is

SELECT USystblDoc.FieldName AS Attribute, USystblDoc.FieldType AS Type, USystblDoc.FieldSize AS [Size], USystblDoc.FieldDflt AS [Default], USystblDoc.FieldReqd AS Reqd, USystblDoc.FieldDescr AS Description
FROM USystblDoc
WHERE [USystblDoc].[TableName]=[Enter Table Name:];


Dodge20

 

[mikevh]

The code assumes that the table "USystblDoc" already
exists. There's no provision here for creating it.
If the table doesn't exist, you'll error out with a
message from "sdaGetAttributes_Err" telling you the
table doesn't exist.

Also, this only records info on tables whose names
begin with "tbl". If you don't have any tables named
like this, "USystblDoc" would be empty after the
program ran and so your query would output nothing.