asked on

Run a simple select statement from one database against the MSysObjects tables in multiple databases.

I need to run a simple select statement from one database against the MSysObjects tables in multiple databases. I have a list of databases and their paths. Since RunSQL method cannot be used with Select statements, this could use Insert statements or Create Table, if necessary.

Background: I have 300+ Access databases on the server. I want to find out how many of them have links to DBF tables. The basic select is this:
SELECT [CurrentProject].[FullName] AS [Database], MSysObjects.Connect, Count(MSysObjects.Id) AS CountOfId
FROM MSysObjects
GROUP BY [CurrentProject].[FullName], MSysObjects.Connect
HAVING ((Left([connect],5)="dBASE"));

I realize the [CurrentProject] won’t return the target database name if run from another db. That info can come from the list of databases used in the loop.

jerryb30

What version of Access on there server databases?

upsfa

ASKER

A mix of 2003 and 2010. All users are moving to 2013 shortly and dbf is no longer supported, so I need to identify what dbs will be affected.

jerryb30

So, you want just the dbf path and name, and the Access db path and name?

jerryb30

Create a module, and paste in the code found here:

http://access.mvps.org/access/api/api0002.htm

Create a table called tblDBs, with 3 fields
SourceDBName, memo
LinkDBFName, memo
Connect, Memo

Have Microsoft Scripting Runtime set as a reference.

Paste following in new module. Modules must have different names than any of the functions.

FunctionFindDatabases(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
on error resume next
Dim FSO As Scripting.FileSystemObject

Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
dim rs as dao.recordset
dim rs2 as dao.recordset
dim strsql as string

    Set FSO = New Scripting.FileSystemObject
    
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    
    For Each FileItem In SourceFolder.Files
      if fileitem.name like "*.mdb" or fileitem.name like "*.accdb" " then
strsql = "Select [name], [connect] from msysobjects in '" & fileitem.name & "' where left(connect,5) = 'dBase'"
set rs = currentdb.openrecordset(strsql)
set rs2 = currentdb.openrecordset("tblDBs")
rs.movefirst
do while not rs.eof
rs2.addnew
rs2!SourcedbName = fileitem.name
rs2!LinkDBFName = rs![name]
rs2!Connect = rs!Connect
rs2.update
rs.movenext
loop
rs.close
rs2.close

endif

'here is where you execute
Function FindDBFConnect()
Dim strfilepath As String
strfilepath = BrowseFolder("Browse to selected folder")
FindDatabases strfilepath, True
End Function

Open in new window

I don't have an environment with linked dbf's.

upsfa

ASKER

Thanks! Looks good, but I got some errors. I also attached a sample dbf you can use, if that will help (just change the extension to dbf after you download).
SAMPLE.txt
errors.JPG

jerryb30

How did I miss this?
in Function FindDatabases
after:
rs.close
rs2.close

endif
next <-add this
end function <-add this

upsfa

ASKER

Thanks, will try. Also, there was no space between Function and FindDatabases in the first line and there was an extra set of quotes on line 18.

upsfa

ASKER

Looks like BrowseFolder variable was never created.
BrowseFolderError.JPG

upsfa

ASKER

I see - BrowseFolder is not a variable, but a function that I don't have.

strfilepath = BrowseFolder("Browse to selected folder")

I just keyed in my test folder directly. It's running now.

strfilepath = "C:\temp\"

upsfa

ASKER

Not getting an error, but it just hangs. There is only one file in the folder I am searching.

jerryb30

I found some more errors.
I'll post new code shortly.
I want to do some more error checking.

jerryb30

I think I have it.
In code I did, I got full path and file name of the mdb in one field, and the concatenation of [DataBase] and [Name] from msysobjects where [Connect] is like 'dbase'
Is that what you need?

upsfa

ASKER

Exactly!

jerryb30

See attached. You could probably use it as is, except for reference versions.
FindDBF.mdb

jerryb30

Out for a while.

upsfa

ASKER

Very nice, but it is not searching sub folders. I see the argument "IncludeSubfolders" being passed in the function, but I can't figure out how to get it to work. Thanks!

jerryb30

Is the server (or starting folder) mapped to a drive letter?

upsfa

ASKER

yes it is.

jerryb30

Did you use the db I posted, or copy things?

upsfa

ASKER

I used your database and when I run the function FindDBFConnect() only databases in the folder I select get added to the tblDBs table. There are many sub folders within that contain databases with links to dbfs.

jerryb30

Hmmm. I did not use sub-folders to test. Doing so now. Some flaw in code?

upsfa

ASKER

I've been trying some things, but have not got it yet. There needs to be some recursive code that actually moves to the sub folder. "For Each FileItem In SourceFolder.Files" Looks like we need to search SubFolder at some point.

jerryb30

I forgot the check on IncludeSubFolders

Add to end of FindDatabases:

Next '<---Add After here
If IncludeSubfolders Then '--->Add
For Each SubFolder In SourceFolder.SubFolders '--->Add
FindDatabases SubFolder.Path, True '--->Add
Next SubFolder '--->Add
End If '--->Add
End Function 'End of addition

jerryb30

here's new db.
NewFindDBF.mdb

upsfa

ASKER

It works, but we have various errors:

"the microsoft access database engine stopped the process because you and antother user are attempting to change the same data at the same time" - running during off-hours should reduce or eliminate this.

"Records cannot be read, no permissions on msysobject" - we can remove that db from lan and run again.

Then we might get "Invalid database object" - I repaired and compacted that one and it worked.

Slow going since we have 800+ database files and 70+ users on the network.

ASKER CERTIFIED SOLUTION

jerryb30

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

upsfa

ASKER

Added some error handling, and it worked like a charm. Great job on the solution! Much appreciated!