如何用代码导入自定义菜单栏

t小宝

在ACCESS中可以手动导入自定义菜单栏和工具栏，怎样用代码来导入？

fswxs

来源：微软中文知识库

要其他数据库中所有对象导入到当前数据库, 请按照下列步骤操作： 1. 启动 Access, 并打开其中想要导入对象数据库。

这可能是一个空数据库。
2. 在数据库窗口, 模块 , 单击， 然后单击 新建 。
3. 在 工具 菜单上, 单击 引用 。 确保 Microsoft DAO 3.6 对象库 ， 或以后的引用列表中选中。 还要确保未选中任何引用到 MicrosoftActiveX 数据对象。 单击 确定 。
4. 键入或粘贴以下代码模块窗口中：
Option Compare Database

Option Explicit

Public Function ImportDb(strPath As String) As Boolean

On Error Resume Next

Dim db As Database 'Database to import
Dim td As TableDef 'Tabledefs in db
Dim strTDef As String 'Name of table or query to import
Dim qd As QueryDef 'Querydefs in db
Dim doc As Document 'Documents in db
Dim strCntName As String 'Document container name
Dim x As Integer 'For looping
Dim cntContainer As Container 'Containers in db
Dim strDocName As String 'Name of document
Dim intConst As Integer
Dim cdb As Database 'Current Database
Dim rel As Relation 'Relation to copy
Dim nrel As Relation 'Relation to create
Dim strRName As String 'Copied relation's name
Dim strTName As String 'Relation Table name
Dim strFTName As String 'Relation Foreign Table name
Dim varAtt As Variant 'Attributes of relation
Dim fld As Field 'Field(s) in relation to copy
Dim strFName As String 'Name of field to append
Dim strFFName As String 'Foreign name of field to append

'Open database which contains objects to import.

Set db = DBEngine.Workspaces(0).OpenDatabase(strPath, True)


'Import tables from specified Access database.

For Each td In db.TableDefs

strTDef = td.Name

If Left(strTDef, 4) <> "MSys" Then

DoCmd.TransferDatabase acImport, "Microsoft Access", strPath, acTable, _
strTDef, strTDef, False

End If

Next


'Import queries.

For Each qd In db.QueryDefs

strTDef = qd.Name

DoCmd.TransferDatabase acImport, "Microsoft Access", strPath, acQuery, _
strTDef, strTDef, False

Next


'Copy relationships to current database.

Set cdb = CurrentDb

For Each rel In db.Relations

With rel

'Get properties of relation to copy.

strRName = .Name
strTName = .Table
strFTName = .ForeignTable
varAtt = .Attributes

'Create relation in current db with same properties.

Set nrel = cdb.CreateRelation(strRName, strTName, strFTName, varAtt)

For Each fld In .Fields

strFName = fld.Name
strFFName = fld.ForeignName
nrel.Fields.Append nrel.CreateField(strFName)
nrel.Fields(strFName).ForeignName = strFFName

Next

cdb.Relations.Append nrel

End With

Next


'Loop through containers and import all documents.

For x = 1 To 4

Select Case x

Case 1
strCntName = "Forms"
intConst = acForm

Case 2
strCntName = "Reports"
intConst = acReport

Case 3
strCntName = "Scripts"
intConst = acMacro

Case 4
strCntName = "Modules"
intConst = acModule
Case 5
_____________
此段内容回复可见
-----------------------
End Select

Set cntContainer = db.Containers(strCntName)

For Each doc In cntContainer.Documents

strDocName = doc.Name

DoCmd.TransferDatabase acImport, "Microsoft Access", strPath, intConst, _
strDocName, strDocName

'Debug.Print strDocName
'for debugging, will list document names in debug window.

Next doc
Next x

'Clean up variables to recover memory.

Set fld = Nothing
Set nrel = Nothing
Set rel = Nothing
Set cdb = Nothing
Set td = Nothing
Set qd = Nothing
Set cntContainer = Nothing

db.Close
Set db = Nothing

ImportDb = True

End Function
     

5. 在 视图 菜单上, 单击 立即窗口 。
6. 立即窗口中键入以下命令行, 然后按 ENTER 键：
? ImportDb("C:\pathname\MySourceDatabase.mdb")
注意 Substitute 对源数据库正确路径和名称。 如果成功运行此代码返回 " True " （或 - 1。

t小宝

这个代码可以导入其它对象，但没有导入自定义菜单栏的选项呀！

莫非TransferDatabase方法还有一个参数隐藏在这里：
Case 5
_____________
此段内容回复可见
-----------------------
End Select

fswxs

原帖由 t小宝 于 2008-1-17 13:30 发表
这个代码可以导入其它对象，但没有导入自定义菜单栏的选项呀！

莫非TransferDatabase方法还有一个参数隐藏在这里：
Case 5
_____________
此段内容回复可见
-----------------------
End Select

那几行字是我加的

andymark

做了个例子，供参考
http://www.office-cn.net/vvb/thread-59258-1-1.html

t小宝

andymark 的方法是添加新的自定义菜单然后复制属性，但有一个问题，即直接拖放数据库对象生成的自定义按钮的属性复制过去是没有用的，不知还能不能够完善一下。

我做了一个用SendKeys语句解决导入自定义菜单的例子

andymark

直接拖放数据库对象　没测试

marlsq

快捷菜单当中的自定义能导出吗？

marlsq

试试看

jsnjhu

学习了！