تصدير أسماء الجداول وأسماء الحقول إلى الإكسل

Option Compare Database

Option Explicit

Sub ListTablesAndFields()

'Macro Purpose: Write all table and field names to and Excel file

Dim lTbl As Long

Dim lFld As Long

Dim dBase As Database

Dim xlApp As Object

Dim wbExcel As Object

Dim lRow As Long

'Set current database to a variable adn create a new Excel instance

Set dBase = CurrentDb

Set xlApp = CreateObject("Excel.Application")

Set wbExcel = xlApp.workbooks.Add

'Set on error in case there is no tables

On Error Resume Next

'Loop through all tables

For lTbl = 0 To dBase.TableDefs.Count - 1

'If the table name is a temporary or system table then ignore it

If Left(dBase.TableDefs(lTbl).Name, 1) = "~" Or _

Left(dBase.TableDefs(lTbl).Name, 4) = "MSYS" Then

'~ indicates a temporary table

'MSYS indicates a system level table

Else

'Otherwise, loop through each table, writing the table and field names

'to the Excel file

For lFld = 0 To dBase.TableDefs(lTbl).Fields.Count - 1

lRow = lRow + 1

With wbExcel.sheets(1)

.range("A" & lRow) = dBase.TableDefs(lTbl).Name

.range("B" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Name

.range("C" & lRow) = FieldType(dBase.TableDefs(lTbl).Fields(lFld).Type)

.range("D" & lRow) = dBase.TableDefs(lTbl).Fields(lFld).Size

End With

Next lFld

End If

Next lTbl

'Resume error breaks

On Error GoTo 0

'Set Excel to visible and release it from memory

xlApp.Visible = True

Set xlApp = Nothing

Set wbExcel = Nothing

'Release database object from memory

Set dBase = Nothing

End Sub

Function FieldType(intType As Integer) As String

Select Case intType

Case dbBoolean

FieldType = "dbBoolean"

Case dbByte

FieldType = "dbByte"

Case dbInteger

FieldType = "dbInteger"

Case dbLong

FieldType = "dbLong"

Case dbCurrency

FieldType = "dbCurrency"

Case dbSingle

FieldType = "dbSingle"

Case dbDouble

FieldType = "dbDouble"

Case dbDate

FieldType = "dbDate"

Case dbText

FieldType = "dbText"

Case dbLongBinary

FieldType = "dbLongBinary"

Case dbMemo

FieldType = "dbMemo"

Case dbGUID

FieldType = "dbGUID"

End Select

End Function