لیست همه جدول‌ها / کوئری‌ها و فیلدهای آنها List of All Tables/Queries and their Fields

[mazoolagh]

این موضوع پیشتر هم اشاره شده ولی من تاپیکی پیدا نکردم که کامل و دقیق پوشش داده باشه.


همونجور که در پست‌های ۱۱۱ تا ۱۱۵ این تاپیک (https://barnamenevis.org/showthread.php?563684&p=2463334&viewfull=1#post2463334) آمده، ۲ راه برای ساخت لیست جدول‌ها/کوئری‌ها هست:
1- جدول سیستمی MSysObjects
2- کالکشن TableDefs/QueryDefs دیتابیس


که روش دویم به دلیل مستندات کامل و دقیق اون بهتر هست.
در روش اول اونچه در دست داریم بیشتر مبتنی روش های سعی و خطاست و این احتمال که بعضی چیزها درست پوشش داده نشده باشه زیاد هست.


با این وجود برای کامل بودن بحث این روش رو هم آوردیم ولی فقط در بخش ساخت لیست جدول/کوئری و نه فیلدهای اونها.


ابتدا یک کلاس برای فیلدها به نام DataField تعریف میکنیم:
Option Compare Database
Option Explicit


Public FieldName As String
Public FieldType As String


و یک کلاس هم برای جدول/کوئری به نام DataSource میسازیم:
Option Compare Database
Option Explicit


Public SourceName As String
Public SourceType As String
Public Fields As Collection
Public FieldsString As String
Public Connect As String


همینجور که مشخص هست فیلدهای یک جدول/کوئری رو به صورت یک Collection از DataField تعریف شدن،
و ویژگی Connect برای Connection String جدول،
و ویژگی FieldsString یک رشته از فیلدها (FieldName,FieldType) رو برمیگردونه که میتونه مستقیما بعنوان RowSource یک ListBox/ComboBox استفاده بشه.

[mazoolagh]

در ادامه به تدریج کدها رو مینویسیم.

از تشخیص نوع Query شروع میکنیم که ساده تر هست.


اگر اطلاعات رو از جدول MSysObjects میخونیم، کوئری ها با Type=5 شناخته میشن و نوع کوئری با Flags مشخص میشه و باید به یاد داشته باشیم کوئری های hidden بیت سوم Flags اونها 1 هست.
اگر اطلاعات رو از کالکشن QueryDefs میخونیم نوع کوئری با Type مشخص میشه که مقدارش همون Flags در MSysObjects هست (خوشبختانه) و hidden بودن اون هم اهمیتی نداره.





Constant
Query type


dbQAction
Action


dbQAppend
Append


dbQCompound
Compound


dbQCrosstab
Crosstab


dbQDDL
Data-definition


dbQDelete
Delete


dbQMakeTable
Make-table


dbQProcedure
Procedure (ODBCDirect workspaces only)
NOTE: ODBCDirect workspaces are not supported in Microsoft Access 2013. Use ADO if you want to access external data sources without using the Microsoft Access database engine.


dbQSelect
Select


dbQSetOperation
Union


dbQSPTBulk
Used with dbQSQLPassThrough to specify a query that doesn't return records (Microsoft Access workspaces only).


dbQSQLPassThrough
Pass-through (Microsoft Access workspaces only)


dbQUpdate
Update



با توجه به جدول بالا از QueryDef.Type property (DAO) (https://learn.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/querydef-type-property-dao) خواهیم داشت:

Public Function QueryType(x As Long) As String
Select Case (x And -9) ' discard bit 3 value (hidden)
Case dbQAction
QueryType = "Query (Action)"
Case dbQAppend
QueryType = "Query (Append)"
Case dbQCompound
QueryType = "Query (Compound)"
Case dbQCrosstab
QueryType = "Query (CrossTab)"
Case dbQDDL
QueryType = "Query (DataDefinition)"
Case dbQDelete
QueryType = "Query (Delete)"
Case dbQMakeTable
QueryType = "Query (MakeTable)"
Case dbQProcedure
QueryType = "Query (Procedure)"
Case dbQSelect
QueryType = "Query (Select)"
Case dbQSetOperation
QueryType = "Query (Union)"
Case dbQSPTBulk
QueryType = "Query (SPTBulk)"
Case dbQSQLPassThrough
QueryType = "Query (PassThrough)"
Case dbQUpdate
QueryType = "Query (Update)"
Case Else
QueryType = "Query (???)"
End Select
End Function

[mazoolagh]

تابع بعدی که آماده میکنیم FieldType هست که نوع فیلد رو از TableDef.Type میگیره و اسم اون رو برمیگردونه.



Name
Value
Description


dbAttachment
101
Attachment data


dbBigInt
16
Big Integer data


dbBinary
9
Binary data


dbBoolean
1
Boolean (True/False) data


dbByte
2
Byte (8-bit) data


dbChar
18
Text data (fixed width)


dbComplexByte
102
Multi-valued byte data


dbComplexDecimal
108
Multi-value decimal data


dbComplexDouble
106
Multi-value double-precision floating-point data


dbComplexGUID
107
Multi-value GUID data


dbComplexInteger
103
Multi-value integer data


dbComplexLong
104
Multi-value long integer data


dbComplexSingle
105
Multi-value single-precision floating-point data


dbComplexText
109
Multi-value Text data (variable width)


dbCurrency
5
Currency data


dbDate
8
Date value data


dbDecimal
20
Decimal data (ODBCDirect only)
NOTE: ODBCDirect workspaces are not supported in Microsoft Access 2013. Use ADO if you want to access external data sources without using the Microsoft Access database engine.


dbDouble
7
Double-precision floating-point data


dbFloat
21
Floating-point data (ODBCDirect only)


dbGUID
15
GUID data


dbInteger
3
Integer data


dbLong
4
Long Integer data


dbLongBinary
11
Binary data (bitmap)


dbMemo
12
Memo data (extended text)


dbNumeric
19
Numeric data (ODBCDirect only)


dbSingle
6
Single-precision floating-point data


dbText
10
Text data (variable width)


dbTime
22
Data in time format (ODBCDirect only)


dbTimeStamp
23
Data in time and date format (ODBCDirect only)


dbVarBinary
17
Variable Binary data (ODBCDirect only)


dbDateTimeExtended
26
Date/Time Extended



با توجه به جدول بالا از DataTypeEnum enumeration (DAO) (https://learn.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/datatypeenum-enumeration-dao) خواهیم داشت:

Public Function FieldType(x As Integer) As String
Select Case x
Case dbBoolean ' 1
FieldType = "Boolean"
Case dbByte ' 2
FieldType = "Byte"
Case dbInteger ' 3
FieldType = "Integer"
Case dbLong ' 4
FieldType = "Long"
Case dbCurrency ' 5
FieldType = "Currency"
Case dbSingle ' 6
FieldType = "Single"
Case dbDouble ' 7
FieldType = "Double"
Case dbDate ' 8
FieldType = "Date/Time"
Case dbBinary ' 9
FieldType = "Binary"
Case dbText ' 10
FieldType = "Text"
Case dbLongBinary ' 11
FieldType = "Long Binary"
Case dbMemo ' 12
FieldType = "Memo"
Case dbGUID ' 15
FieldType = "GUID"
Case dbBigInt ' 16
FieldType = "Big Integer"
Case dbVarBinary ' 17
FieldType = "Binary (ODBC)"
Case dbChar ' 18
FieldType = "Text(fixed width)"
Case dbNumeric ' 19
FieldType = "Numeric (ODBC)"
Case dbDecimal ' 20
FieldType = "Decimal"
Case dbFloat ' 21
FieldType = "Float (ODBC)"
Case dbTime ' 22
FieldType = "Date/Time (ODBC)"
Case dbTimeStamp ' 23
FieldType = "Date/Time Extended (ODBC)"
Case 26 ' dbDateTimeExtended
FieldType = "Date/Time Extended"
Case dbAttachment ' 101
FieldType = "Attachment"
Case dbComplexByte ' 102
FieldType = "Multi-valued Byte"
Case dbComplexInteger ' 103
FieldType = "Multi-value Integer"
Case dbComplexLong ' 104
FieldType = "Multi-value Long"
Case dbComplexSingle ' 105
FieldType = "Multi-value Single"
Case dbComplexDouble ' 106
FieldType = "Multi-value Double"
Case dbComplexGUID ' 107
FieldType = "Multi-value GUID"
Case dbComplexDecimal ' 108
FieldType = "Multi-value Decimal"
Case dbComplexText ' 109
FieldType = "Multi-value Text"
End Select
End Function

[mazoolagh]

کد بعدی تابع GetFields هست که اسم source و نوع اون (جدول/کوئری) رو دریافت میکنه و یک Collection از نوع DataField برمیگردونه:

Public Enum SourceType
Table = 1
Query = 2
End Enum

Public Function GetFields( _
SourceName As String, _
SourceType As SourceType _
) As Collection

Dim xDef As Variant
Dim fldType As String
Dim fld As Field
Dim df As DataField
Dim dbs As Database

Set GetFields = New Collection
Set dbs = CurrentDb

If SourceType Like Query Then
Set xDef = dbs.QueryDefs(SourceName)
Else
Set xDef = dbs.TableDefs(SourceName)
End If

For Each fld In xDef.Fields
Set df = New DataField
df.FieldName = fld.Name
fldType = FieldType(fld.Type)
If fldType = "Text" Then
df.FieldType = fldType & "(" & fld.Size & ")"
Else
df.FieldType = fldType
End If
GetFields.Add df
Next
Set dbs = Nothing
End Function

در کنار این، تابع FieldsString رو هم داریم :
Public Function FieldsString(ByRef Fields As Collection) As String
Dim i As Integer
For i = 1 To Fields.count
With Fields.Item(i)
FieldsString = FieldsString & .FieldName & ";" & .FieldType & ";"
End With
Next
End Function

این تابع مجموعه فیلدها (و نوع اونها رو) به شکل یک string جداشده با ; برمیگردونه،
که اختصاصا برای استفاده به عنوان rowsource یک کمبوباکس/لیست‌باکس کاربرد داره.

[mazoolagh]

الان که مقدمات آماده است، میتونیم توابع اصلی رو بنویسیم:

تابع GetTables که لیست همه جدولها رو در یک Collection از DataSource برمیگردونه
تابع GetQueries .... کوئری‌ها ....


Public Function GetTables() As Collection
Set GetTables = New Collection
Dim td As TableDef
Dim ds As DataSource
Dim i As Integer
Dim fs As String

For Each td In CurrentDb.TableDefs
If (td.Name Like "Msys*" Or td.Name Like "~*") Then GoTo Skip_Table
Set ds = New DataSource
With ds
.SourceName = td.Name
.connect = td.connect
If Nz(.connect) = "" Then
.SourceType = "Table"
Else
.SourceType = LinkedTableType(.connect)
End If
Set .Fields = GetFields(SourceName:=.SourceName, SourceType:=Table)
.FieldsString = FieldsString(.Fields)
.connect = td.connect
End With
GetTables.Add ds
Skip_Table:
Next
End Function

که تابع LinkedTableType بر اساس connection string جدول، نوع جدول (لینک شده) رو برمیگردونه - توضیح در پست بعدی.

Public Function GetQueries() As Collection
Set GetQueries = New Collection
Dim qd As QueryDef
Dim ds As DataSource
Dim i As Integer
Dim fs As String

For Each qd In CurrentDb.QueryDefs
If qd.Name Like "~*" Then GoTo Skip_Query
Set ds = New DataSource
With ds
.SourceName = qd.Name
.SourceType = QueryType(qd.Type)
Set .Fields = GetFields(SourceName:=.SourceName, SourceType:=Query)
.FieldsString = FieldsString(.Fields)
.connect = qd.connect
End With
GetQueries.Add ds
Skip_Query:
Next
End Function

[mazoolagh]

Database type
Specifier
Example


Microsoft Access Database
[database];
drive:\path\filename


dBASE III
dBASE III;
drive:\path


dBASE IV
dBASE IV;
drive:\path


dBASE 5
dBASE 5.0;
drive:\path


Paradox 3.x
Paradox 3.x;
drive:\path


Paradox 4.x
Paradox 4.x;
drive:\path


Paradox 5.x
Paradox 5.x;
drive:\path


Microsoft Excel 3.0
Excel 3.0;
drive:\path\filename.xls


Microsoft Excel 4.0
Excel 4.0;
drive:\path\filename.xls


Microsoft Excel 5.0 or Microsoft Excel 95
Excel 5.0;
drive:\path\filename.xls


Microsoft Excel 97
Excel 8.0;
drive:\path\filename.xls


Lotus 1-2-3 WKS and WK1
Lotus WK1;
drive:\path\filename.wk1


Lotus 1-2-3 WK3
Lotus WK3;
drive:\path\filename.wk3


Lotus 1-2-3 WK4
Lotus WK4;
drive:\path\filename.wk4


HTML Import
HTML Import;
drive:\path\filename


HTML Export
HTML Export;
drive:\path


Text
Text;
drive:\path


ODBC
ODBC; DATABASE=database; UID=user; PWD=password; DSN= datasourcename; [LOGINTIMEOUT=seconds;]
None


Microsoft Exchange
Exchange 4.0; MAPILEVEL=folderpath; [TABLETYPE={ 0 | 1 }];[PROFILE=profile;] [PWD=password;] [DATABASE=database;]
drive:\path\filename



با توجه به جدول بالا از TableDef.Connect property (DAO) (https://learn.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/tabledef-connect-property-dao) خواهیم داشت:

Public Function LinkedTableType(connect As String) As String
If connect = "" Or connect Like ";*" Then
LinkedTableType = "Linked (Access)"
ElseIf connect Like "Text*" Then
LinkedTableType = "Linked (Text)"
ElseIf connect Like "Excel*" Then
LinkedTableType = "Linked (Excel)"
ElseIf connect Like "HTML*" Then
LinkedTableType = "Linked (HTML)"
ElseIf connect Like "Exchange*" Then
LinkedTableType = "Linked (Exchange)"
ElseIf connect Like "ODBC*" Then
LinkedTableType = "Linked (ODBC)"
ElseIf connect Like "Paradox*" Then
LinkedTableType = "Linked (Paradox)"
ElseIf connect Like "dBASE*" Then
LinkedTableType = "Linked (dBASE)"
ElseIf connect Like "Lotus*" Then
LinkedTableType = "Linked (Lotus)"
Else
LinkedTableType = "Linked (Other)"
End If
End Function

[mazoolagh]

خواسته آموزش در اینجا برآورده شده ولی بحث هنوز قابل ادامه است.

توابع پست شماره 5 براساس استفاده از TableDefs/QueryDefs ساخته شده،
ولی همینجور که قبلا هم اشاره شد میتونیم از جدول سیستمی MSysObjects هم این اطلاعات رو بگیریم.
گرچه روش اصلی بهتر هست ولی برای تکمیل بحث، توابع پست 5 بر این مبنا به شکل زیر خواهد بود:

Public Function GetTablesFromMSysObjects() As Collection
Dim rs As Recordset
Dim ds As DataSource
Dim i As Integer

Set GetTablesFromMSysObjects = New Collection
Set rs = CurrentDb.OpenRecordset( _
Name:="SELECT [NAME], [TYPE], [FLAGS], [Connect] " & _
"FROM MSYSOBJECTS " & _
"WHERE [FLAGS]>=0 AND " & _
"[NAME] NOT LIKE ""MSYS*"" AND " & _
"[NAME] NOT LIKE ""~*"" AND " & _
"[TYPE] IN (1,4,6)", _
Type:=dbReadOnly, _
options:=dbForwardOnly)

Do Until rs.EOF
Set ds = New DataSource
With ds
.SourceName = rs("Name")
.connect = Nz(rs("Connect"))
Select Case rs("Type")
Case 1
.SourceType = "Table"
Case 4
Dim x
x = Split(Replace(.connect, "DRIVER=", ""), " ")
.SourceType = "Linked (" & x(0) & ")"
Case 6
.SourceType = LinkedTableType(.connect)
End Select
Set .Fields = GetFields(SourceName:=.SourceName, SourceType:=Table)
.FieldsString = FieldsString(.Fields)
End With
GetTablesFromMSysObjects.Add ds
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End Function

Public Function GetQueriesFromMSysObjects() As Collection
Dim rs As Recordset
Dim ds As DataSource
Dim i As Integer

Set GetQueriesFromMSysObjects = New Collection
Set rs = CurrentDb.OpenRecordset( _
Name:="SELECT [NAME], [TYPE], [FLAGS], [Connect] " & _
"FROM MSYSOBJECTS " & _
"WHERE [FLAGS]>=0 AND " & _
"[NAME] NOT LIKE ""~*"" AND " & _
"[TYPE] = 5", _
Type:=dbReadOnly, _
options:=dbForwardOnly)

Do Until rs.EOF
Set ds = New DataSource
With ds
.SourceName = rs("Name")
.SourceType = QueryType(rs("Flags"))
.connect = Nz(rs("Connect"))
Set .Fields = GetFields(SourceName:=.SourceName, SourceType:=Query)
.FieldsString = FieldsString(.Fields)
End With
GetQueriesFromMSysObjects.Add ds
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End Function