Iterating Access db's

[MajP]

However if I have code that opens the specific database and then the function ends and afterwards I use the snippet of code to close the said database in a separate function, then it doesn't work as it doesn't seem to 'remember' the value of the specific db in MyDict.

Sorry, that is not correct and you can test this quite simply. If I have a module level container and put a pointer in there that pointer remains even if the object reference goes out of scope.

Question. What will happen when I run testscope2?

Public myDict2 As Dictionary
Public Sub TestScope()
 Dim ws1 As Worksheet
 Set ws1 = ActiveSheet
 Set myDict2 = New Dictionary
 myDict2.Add ws1.Name, ws1
 'ws1 is out of scope and set to nothing but a pointer exists in myDict2
 Set ws1 = Nothing
End Sub

Public Sub testscope2()
  'ws1 is out of scope but pointer to active sheet exists
  Debug.Print myDict2.Item(myDict2.Keys(0)).Name
End Sub

 

[aziz rasul]

But if I run

Public Sub TestScope()

say from cmdbutton1 and then separately run

Public Sub testscope2()

from cmdbutton2 then it doesn't work.

If I run both subs consecutively then the code runs OK.

 

[MajP]

Are you declaring your dictionary in a standard module? In my example the code is in
mdlTwo and I declare myDict2 as public

Public myDict2 As Dictionary

Public Sub TestScope()
 Dim ws1 As Worksheet
 Set ws1 = ActiveSheet
 Set myDict2 = New Dictionary
 myDict2.Add ws1.Name, ws1
 'ws1 is out of scope and set to nothing but a pointer exists in myDict2
 Set ws1 = Nothing
End Sub
Public Sub testscope2()
  'ws1 is out of scope but pointer to active sheet exists
 MsgBox myDict2.Item(myDict2.Keys(0)).Name
End Sub

Here is my code in a user form

Private Sub CommandButton1_Click()
  TestScope
End Sub
Private Sub CommandButton2_Click()
 testscope2
End Sub

If I run cmd1 then cmd2 it works. In fact I can close the userform, change the active sheet, open the user form and select command2. It will reference the original sheet.

 

[aziz rasul]

The fact that you get it to work, gives me hope. I'm obviously doing something wrong.

I have a single module with the code like so:-

Option Explicit
Public MyDict As Dictionary

Public Function OpenDatabase(strFilepath As String, strFilename As String) As Boolean

    Dim objAccessApp As Object
    
    Set MyDict = New Dictionary
    Set objAccessApp = CreateObject("Access.Application")
    
    objAccessApp.OpenCurrentDatabase (strFilepath & strFilename)

    With objAccessApp
        .Visible = True
        MyDict.Add objAccessApp.CurrentProject.Name, objAccessApp
        Debug.Print MyDict.Item(MyDict.Keys(0)).Name
    End With
    
End Function

Public Sub CloseAccessFile(strAccessFile As String)

    Dim objAccessApp As Object
    
    Debug.Print MyDict.Item(MyDict.Keys(0)).Name ‘Error 91 - Object variable or With block variable not set

    If MyDict.Exists(strAccessFile) Then
        Set objAccessApp = MyDict(strAccessFile)
        MyDict.Remove strAccessFile
        objAccessApp.CloseCurrentDatabase
        objAccessApp.DoCmd.Quit acQuitSaveAll
        Set objAccessApp = Nothing
    End If
    
End Sub

 

[aziz rasul]

It doesn't work (using a test module) when I run the Opening file code and then stop the code and then run the Closing file code, separately.

However it does work via 2 command buttons to open and close the file respectively on a user form.

Why it should make a difference, I don't know.

 

[MajP]

Since you call the function many times you cannot have this code in your function

Set MyDict = New Dictionary

You are createing a new instance each time. You need to create it once. The easy way then would be to declare and instantiate at the same time using New keyword.

Public MyDict As NEW Dictionary

Public Function OpenDatabase(strFilepath As String, strFilename As String) As Boolean

    Dim objAccessApp As Object
    Set objAccessApp = CreateObject("Access.Application")
    objAccessApp.OpenCurrentDatabase (strFilepath & strFilename)

    With objAccessApp
        .Visible = True
        MyDict.Add objAccessApp.CurrentProject.Name, objAccessApp
        Debug.Print MyDict.Item(MyDict.Keys(0)).Name
    End With
    
End Function

However, I agree with others that this may not be a good way, but just trying to show code that answers the original questions.

 

[aziz rasul]

Still didn't work I'm afraid.

 

[MajP]

Do not know what to say. Works fine for me. Here is my module using your code.

Option Explicit
Public MyDict As New Dictionary

Public Function OpenDatabase(strFilepath As String, strFilename As String) As Boolean
    Dim objAccessApp As Object
    Set objAccessApp = CreateObject("Access.Application")
    objAccessApp.OpenCurrentDatabase strFilepath & strFilename
    With objAccessApp
        .Visible = True
        MyDict.Add objAccessApp.CurrentProject.Name, objAccessApp
        Debug.Print MyDict.Item(MyDict.Keys(0)).Name
    End With
End Function

Public Sub CloseAccessFile(strAccessFile As String)
    Dim objAccessApp As Object
    If MyDict.Exists(strAccessFile) Then
        Set objAccessApp = MyDict(strAccessFile)
        MyDict.Remove strAccessFile
        objAccessApp.CloseCurrentDatabase
        objAccessApp.DoCmd.Quit acQuitSaveAll
        Set objAccessApp = Nothing
    End If
End Sub

Here is my user form with 4 command buttons

Private Sub cmdOpen1_Click()
  OpenDatabase Application.ActiveWorkbook.Path & "\", "zigzag.accdb"
End Sub

Private Sub cmdOpen2_Click()
  OpenDatabase Application.ActiveWorkbook.Path & "\", "zigzag2.accdb"
End Sub

Private Sub cmdClose1_Click()
  CloseAccessFile "zigzag.accdb"
End Sub

Private Sub cmdClose2_Click()
  CloseAccessFile "zigzag2.accdb"
End Sub

It opens and closes the correct dbs open in any order.

 

[MajP]

Here is another version, that uses the default workspace. You do not have to open multiple access apps, if you do not want to. Still have to hold a pointer to the databases if you want to open them, do stuff, and then close them individually.

Option Explicit
Public MyDict As New Dictionary

'Need MS Office 16.0 Access Database Engine Object

Public Sub OpenDBs(strFilepath As String, strFileName As String)
 Dim myDb As DAO.Database
 Dim daoDbs As Database
 Dim strOut As String
 Dim counter As Integer
 Set myDb = DBEngine.Workspaces(0).OpenDatabase(strFilepath & strFileName, True)
 
 For Each daoDbs In DBEngine.Workspaces(0).Databases
  strOut = strOut & vbCrLf & daoDbs.Name
  counter = counter + 1
 Next daoDbs
 MyDict.Add strFilepath & strFileName, myDb
 MsgBox "There are " & counter & " dbs in the default workspace: " & vbCrLf & strOut
End Sub
Public Sub CloseDBs(strFilepath As String, strFileName As String)
    Dim db As DAO.Database
    Dim strAccessFile As String
    strAccessFile = strFilepath & strFileName
    If MyDict.Exists(strAccessFile) Then
        Set db = MyDict(strAccessFile)
        MyDict.Remove strAccessFile
        db.Close
    End If
End Sub

Here is my demo with a user form and added a command button to loop the databases that are open.

Private Sub cmdOpen1_Click()
  OpenDBs Application.ActiveWorkbook.Path & "\", "zigzag.accdb"
End Sub

Private Sub cmdOpen2_Click()
  OpenDBs Application.ActiveWorkbook.Path & "\", "zigzag2.accdb"
End Sub

Private Sub cmdClose1_Click()
  CloseDBs Application.ActiveWorkbook.Path & "\", "zigzag.accdb"
End Sub

Private Sub cmdClose2_Click()
  CloseDBs Application.ActiveWorkbook.Path & "\", "zigzag2.accdb"
End Sub
Private Sub CommandButton1_Click()
  'Show what is in the default workspace
  Dim daoDbs As DAO.Database
  Dim strOut As String
  Dim counter As Integer
  For Each daoDbs In DBEngine.Workspaces(0).Databases
    strOut = strOut & vbCrLf & daoDbs.Name
    counter = counter + 1
  Next daoDbs
 MsgBox "There are " & counter & " dbs in the default workspace: " & vbCrLf & strOut
End Sub

 

[The_Doc_Man]

MajP - are you taking into account that Aziz is running this from Excel? I have to admit having never run VBA from Excel because I just never had to. (Did it from Word once or twice but that was a long time ago for a limited macro function.)

 

[MajP]

Yes this is all code in Excel, but sure you could drop same code into Word, Power Point, etc. Could do the same with ADO, but prefer to stick to the native access interface DAO when working JET. I assume if this was in Access you would just link to those tables in the external dbs. Still trying to understand if there is a reason to open the application, the OP hints he wants the db open an visible. If not just open the database connection like done in the last example.

 

[aziz rasul]

Thanks for all your help MajP. The code works when I use a user form so I am happy and content with that.
Will look into how to get data without opening the Access database. I didn't know you could do that.

 

[MajP]

Will look into how to get data without opening the Access database.

To be clear you are still opening the database but just the database and not the Access application. You open the databases through the dao DBengine (specifically the default workspace). Once open in the workspace you can do whatever you want against the different databases. You never explained what you did with the open databases. If you are creating recordsets or executing SQL nothing would change, except that the database is not open in Access window and thus you do not have the overhead of Access.

If I open the databases like below or open them through the access application as done previously nothing else code wise would change.

Public Sub OpenDBs(strFilepath As String, strFileName As String)
 Dim myDb As DAO.Database
 Dim daoDbs As Database
 Dim strOut As String
 Dim counter As Integer
 Set myDb = DBEngine.Workspaces(0).OpenDatabase(strFilepath & strFileName, True)
 'for demo
 'For Each daoDbs In DBEngine.Workspaces(0).Databases
 ' strOut = strOut & vbCrLf & daoDbs.Name
 ' counter = counter + 1
' Next daoDbs
 MyDict.Add strFilepath & strFileName, myDb
' MsgBox "There are " & counter & " dbs in the default workspace: " & vbCrLf & strOut
End Sub

 

[aziz rasul]

I will look at this on Monday. I may have started on the wrong foot. Part of what I was doing was to 'grab' data using a recordset and also run some queries e.g.

dbs.DoCmd.OpenQuery "Query1"

Now that I know I can get what I want without opening the Access application, I hope it will make life easier.

Is the converse also the case i.e. not opening the Excel application when using MS Access to obtain Excel data?

 

[MajP]

If running some queries to view the data you might want to look at the range copy from recordset method
https://docs.microsoft.com/en-us/office/vba/api/excel.range.copyfromrecordset

This way you can run a query and create the RS then show that in Excel.

Also have you looked at just using MS Query from out of Excel? Probably should have asked that earlier. Obviously it is very powerful, but I just do not have the knowledge of automating it. If the datasources are not changing and you pull the same data, that may just be all you need.

 

[aziz rasul]

Something else to think about.