用VFP列出ACCESS所有表的字段结构，含标题。

来源：互联网发布：亿人围观网络春晚编辑：程序博客网时间：2024/06/04 15:59

set safety off

local oo,lcStr,lcMdbFile,i,x,lnFields,lcTableName,lnFieldtype,lcCurdir

lcCurdir = sys(5) + curdir()

lcNowdir = getdir()

cd (lcNowdir)

oo = NEWOBJECT('Access.Application')

oo.AutomationSecurity = 1

oo.UserControl = .F.

lcMdbFile = getFile('mdb')

if not empty(lcMDBFile)

oo.OpenCurrentDatabase(lcMDBFile)

lnTables = oo.CurrentDb.TableDefs.Count

for i = 5 to lnTables - 1

lcStr = ''

lnFields = oo.CurrentDb.TableDefs(i).fields.count

*lcTableName = JUSTSTEM(lcMDBFile) + '_' + oo.CurrentDb.TableDefs(i).Name

lcTableName = oo.CurrentDb.TableDefs(i).Name

*use

if i = 5

* create Table (lcTableName) (字段名 char(10),类型 char(10),宽度 char(4),小数位 char(4),标题 char(50),对应字段 char(20))

create Table blank (字段名 char(9),类型 char(10),宽度 char(2),小数位 char(4),标题 char(24),对应字段 char(20),表名 char(10))

endif

for x = 0 to lnFields - 1

append blank

lnFieldType = oo.CurrentDb.TableDefs(i).Fields(x).type

do case

case lnFieldType = 10

lcType = '字符型'

case lnFieldType = 5

lcType = '货币型'

case lnFieldType = 8

lcType = '日期时间型'

case lnFieldType = 3

lcType = '整型'

case lnFieldType = 6

lcType = '单精度型'

otherwise

lcType = ltrim(str(oo.CurrentDb.TableDefs(i).Fields(x).type))

endcase

replace 字段名 with oo.CurrentDb.TableDefs(i).Fields(x).name

replace 类型 with lcType

replace 宽度 with ltrim(str(oo.CurrentDb.TableDefs(i).Fields(x).size))

if inlist(lnFieldType,3,5,6)

lnValue = oo.Currentdb.TableDefs(i).Fields(x).Properties('DecimalPlaces').Value

replace 小数位 with icase(lnValue = 255,'自动',alltrim(str(lnValue)))

endif

replace 标题 with oo.CurrentDb.TableDefs(i).Fields(x).Properties('caption').value

replace 表名 with lcTableName

endfor

*copy To (lcTableName) type xl5

*use

endfor

endif

oo.CloseCurrentDatabase()

oo = null

cd (lcCurdir)

在此感谢“都市夜猫”的指导。