function lj()
dim catdb as adox.catalog
dim tbllink as adox.table

set catdb = new adox.catalog
catdb.activeconnection = currentproject.connection

set tbllink = new adox.table ' 建立一个新的表对象

with tbllink
.name = "订单" ' 链接表名称
set .parentcatalog = catdb

.properties("jet oledb:create link") = true
.properties("jet oledb:link datasource") = _
"c:\program files\zhanyexing\123.mdb"
.properties("jet oledb:link provider string") = _
"ms access;pwd=123;" ' 提供者及密码
.properties("jet oledb:remote table name") = "订单" ' 原数据库中的表
end with

catdb.tables.append tbllink ' 添加到库中
set tbllink = nothing
end function

注：在vba编辑器中引用"microsoft ado ext. 2.5 for ddl and security"以及"microsoft activex data objects 2.1/2.5/2.6/2.7 library"

转自 朱亦文 的个人主页.