CODEWITHSUNDEEP
vbams-access
Challenger
Challenger

Reputation: 127

MS ACCESS Passing Database Property on creating new database?

I`m trying to create something like deploying databases like a distribution. Create a small databases from my Main Database and after that attached to mail and send to another guys. Why I have to do this is long story but I have to do it.

I can create databases transfer tables queries but I do not know how to send properties, like the below. And If someone has another way of doing it thats fine too. Have to distributes in 10 different places. But I need to get there in locked mode and pop up form automatically.

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

Upvotes: 0

Views: 548

Answers (1)

4dmonster
4dmonster

Reputation: 3031

try this

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

Upvotes: 1

Related Questions