MS ACCESS通过数据库属性创建新的数据库？

Question

我尝试创建类似于分布式部署数据库的东西。从我的主数据库创建一个小型数据库，然后附加到邮件并发送给其他人。 为什么我必须这样做是漫长的故事，但我必须这样做。

我可以创建数据库转移表查询，但我不知道如何发送属性，如下所示。如果有人有另一种做法，那也很好。 必须分布在10个不同的地方。但我需要在锁定模式下进入并自动弹出窗体。

Public Function fnc_CreateAccessChicago()  
    Dim acApp As Access.Application 
    Set acApp = New Access.Application 
    acApp.Application.NewCurrentDatabase ("C:\TestTest\ChicagpDatabase") 

------ acApp.Properties("StartupForm") = "frmAssetChicago" ---- 

    acApp.Quit 
End Function 

Public Function fnc_Transfers() 
    DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\TestTest\ChicagoDatabase.accdb", acTable, "tblAllAsset", "tblAllAsset" 
    DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\TestTest\ChicagoDatabase.accdb", acQuery, "QryAssetChicago", "QryAssetChicago" 
    DoCmd.TransferDatabase acExport, "Microsoft Access", "C:\TestTest\ChicagoDatabase.accdb", acForm, "frmAssetChicago", "frmAssetChicagoF" 
End Function 

Answer 1

试试这个

Public Sub CopyProperties(dstDBname As String) 
' copy properties from currentdb() to dstDBname 
    Dim dstDB As Database 
    Dim srcDB As Database 
    Dim ws As Workspace 
    Dim srcP As Property 
    Dim dstP As Property 

    Set srcDB = CurrDB() 
    Set ws = DefaultWorkspaceClone() 
    Set dstDB = ws.OpenDatabase(dstDBname) 

    For Each srcP In srcDB.Properties 
     Debug.Print srcP.Name, 
     If (srcP.Name <> "Name") And (srcP.Name <> "Connection") Then 
      If (Nz(srcP.value, "") <> "") Then 
       Set dstP = dstDB.CreateProperty(srcP.Name, srcP.Type, Nz(srcP.value, "")) 
       On Error Resume Next 
       dstDB.Properties.Append dstP 
       dstDB.Properties(srcP.Name).value = srcP.value 
       On Error GoTo 0 
      End If 
      Debug.Print "set", srcP.value 
     End If 
     Debug.Print 
    Next srcP 
    dstDB.Properties.Refresh 
    dstDB.Close 
    Set dstDB = Nothing 
    Set srcDB = Nothing 
    Set ws = Nothing 
End Sub