VBA/Excel/Access/Word/Access/Workspaces

Материал из VB Эксперт

Перейти к: навигация, поиск

Содержание

Closes the Workspace

 
Sub closeWorkspace()
    Dim myWorkspace As Workspace
    Set myWorkspace = DBEngine.Workspaces(0)
    myWorkspace.Close
End Sub



Closing a Database

 
Sub close()
    Dim myWorkspace As Workspace
    Dim myDatabase As Database
 
    Set myWorkspace = DBEngine.Workspaces(0)
    Set myDatabase = myWorkspace.OpenDatabase(Name:= "\\server\database\Testing.mdb",Options:=True, ReadOnly:=False)
    myDatabase.Close
End Sub



Get database from Workspace

 
Sub exaCurrentDB()
    Dim db, dbExtra, dbOriginal As Database
    Dim i As Integer
 
    Set dbOriginal = DBEngine(0)(0)
    Debug.Print DBEngine.Workspaces(0).Databases.Count
 
    Set dbExtra = CurrentDb()
    Debug.Print DBEngine.Workspaces(0).Databases.Count
 
    For Each db In DBEngine.Workspaces(0).Databases
        Debug.Print db.Name
    Next db
 
    dbExtra.Close
End Sub



Get Workspaces count and name

 
Sub test()
 
    MsgBox "Workspace Count: " & DBEngine.Workspaces.Count
    MsgBox "Workspace Name: " & DBEngine.Workspaces(0).Name
End Sub



List group user

 
Public Sub ListGroupsForUser()
    Dim myWorksheetNew      As Workspace
    Dim grpUG       As Group        " user group
    Set myWorksheetNew = DBEngine.CreateWorkspace("AdminWorkspace", "Admin", "")
    Debug.Print "Groups for user " & CurrentUser() & " are:"
    For Each grpUG In myWorksheetNew.Users(CurrentUser()).Groups
        Debug.Print grpUG.Name
    Next
    myWorksheetNew.Close
    Set myWorksheetNew = Nothing
    Set grpUG = Nothing
End Sub



Lists the tables in the LIBRARY database

 
Sub exaTables()
    Dim dbLibrary As Database
    Dim tblLibrary As TableDef
    Set dbLibrary = DBEngine.Workspaces(0).Databases(0)
    Debug.Print "Tables in LIBRARY"
 
    For Each tblLibrary In dbLibrary.TableDefs
        Debug.Print tblLibrary.Name
    Next tblLibrary
End Sub



Makes the admin account the owner of the new workspace.

 
Sub admin()
    Dim myWorkspace As Workspace
    Set myWorkspace = CreateWorkspace(Name:="Workspace2",UserName:="admin", Password:="", UseType:=dbUseJet)
End Sub



Open an Access database on the server

 
Sub work()
    Dim myWorkspace As Workspace
    Dim myDatabase As Database
 
    Set myWorkspace = DBEngine.Workspaces(0)
    Set myDatabase = myWorkspace.OpenDatabase(Name:= "\\server\database\Testing.mdb", Options:=True, ReadOnly:=False)
End Sub



Opens Database in exclusive mode with read/write access

 
Sub work()
    Dim myWorkspace As Workspace
    Dim myDatabase As Database
 
    Set myWorkspace = DBEngine.Workspaces(0)
    Set myDatabase = myWorkspace.OpenDatabase(Name:= "\\server\database\Testing.mdb", Options:=True, ReadOnly:=False)
End Sub



Reference database from DBEngine

 
Sub exaObjVar()
    Dim ws As Workspace
    Dim dbLib As Database
    Dim tdfBooks As TableDef
 
    Set ws = DBEngine.Workspaces(0)
    Set dbLib = ws.Databases![d:\library.mdb]
    Set tdfBooks = dbLib.TableDefs!BOOKS
 
    Debug.Print tdfBooks.RecordCount
End Sub



Reference recordset and table with DBEngine

 
Sub exaDefaultCollections()
    Debug.Print DBEngine.Workspaces(0).Databases![d:\dbase\library.mdb].TableDefs!BOOKS.RecordCount
 
    Debug.Print DBEngine(0).Databases![d:\dbase\library.mdb].TableDefs!BOOKS.RecordCount
 
    Debug.Print DBEngine(0)![d:\dbase\library.mdb].TableDefs!BOOKS.RecordCount
 
    Debug.Print DBEngine(0)![d:\dbase\library.mdb]!BOOKS.RecordCount
 
    Debug.Print DBEngine(0)(0)!BOOKS.RecordCount
End Sub



To show that the CurrentDb function adds to the Databases collection

 
Sub exaCurrentDb()
    Dim db, dbExtra, dbOriginal As Database
    Dim str As String
    Dim i As Integer
 
    Set dbOriginal = DBEngine(0)(0)
    Debug.Print DBEngine.Workspaces(0).Databases.Count
    Set dbExtra = CurrentDb()
    Debug.Print DBEngine.Workspaces(0).Databases.Count
    For Each db In DBEngine.Workspaces(0).Databases
        Debug.Print db.Name
    Next db
    dbExtra.Close
End Sub



Use DBEngine to reference tables and its columns

 
Sub exaCollections()
    Dim colParent As New Collection
    Dim colChild As New Collection
 
    Dim tdfBooks As TableDef
    Dim objVar As Object
 
    Set tdfBooks = DBEngine(0)(0).TableDefs!BOOKS
    colParent.Add colChild
    colParent.Add tdfBooks
    Debug.Print colParent.Count
    For Each objVar In colParent
        If TypeOf objVar Is Collection Then
            Debug.Print "Collection"
        ElseIf TypeOf objVar Is TableDef Then
            Debug.Print objVar.Name
        End If
    Next
End Sub