reference application object of mdb opened with OpenDatabase

  • Thread starter Thread starter Matt Williamson
  • Start date Start date
M

Matt Williamson

I'm looping through all access mdb's in a directory and changing all of
the SQL links to be DSNless. At the same time I'd like to update the
TransferText path in a bunch of Macros but I can't figure out how to
reference the application object of the database I just opened. This
code works fine for the current database if I add it a module and run
it. How do I reference the application object of another database
without creating a new app instance?

Sub FixPathInMacros()
Dim obj As AccessObject, dbs As Object
Set dbs = Application.CurrentProject
' Search for open AccessObject objects in AllMacros collection.
For Each obj In dbs.AllMacros
If obj.IsLoaded = True Then
' Print name of obj.
Debug.Print cp.Name & "_" & obj.Name
'SaveAsText acMacro, obj.Name, "C:\Temp\" _
& obj.Name & ".txt"
'FixPath "C:\Temp\" & obj.Name & ".txt", _
"\\\Server\\Folder\\"
'LoadFromText acMacro, obj.Name, "C:\Temp\" & _
obj.Name & ".txt"
End If
Next obj
End Sub

TIA

Matt
 
Matt Williamson said:
I'm looping through all access mdb's in a directory and changing all of
the SQL links to be DSNless. At the same time I'd like to update the
TransferText path in a bunch of Macros but I can't figure out how to
reference the application object of the database I just opened. This code
works fine for the current database if I add it a module and run it. How
do I reference the application object of another database without creating
a new app instance?

Sub FixPathInMacros()
Dim obj As AccessObject, dbs As Object
Set dbs = Application.CurrentProject
' Search for open AccessObject objects in AllMacros collection.
For Each obj In dbs.AllMacros
If obj.IsLoaded = True Then
' Print name of obj.
Debug.Print cp.Name & "_" & obj.Name
'SaveAsText acMacro, obj.Name, "C:\Temp\" _
& obj.Name & ".txt"
'FixPath "C:\Temp\" & obj.Name & ".txt", _
"\\\Server\\Folder\\"
'LoadFromText acMacro, obj.Name, "C:\Temp\" & _
obj.Name & ".txt"
End If
Next obj
End Sub
Click to expand...

A DAO database object, such as is returned by the OpenDatabase method,
doesn't *have* an Application object. It's just a representation of the
database, with no Access application associated with it. I don't know if
you can get at the details (actions and arguments) of a macro without
creating an Access Application object, opening the database in that object,
and working from there.
 
Douglas said:
I don't believe there's any way to avoid creating a new app instance.
Click to expand...

That's what I was afraid of but only because I can't figure out out how
to make it work. Here are my routines, maybe you can see what I'm doing
wrong. When I step through the code it hits the For each obj in
dbs.AllMacros and then goes to the error handler in the SeachForFiles
routine and returns Error 2467: The expression you entered refers to an
object that is closed or doesn't exist.

Help. ;)


Public Sub ChangeTableLinksInMDBs()
Dim sPath As String, sMDB As String

sPath = "X:\ACCESS\Conversion 97 to 2003\1"

With fp
.sFileRoot = QualifyPath(sPath) 'start path
.sFileNameExt = "*.mdb" 'file type(s) of interest
.bRecurse = True 'True = recursive search
.nCount = 0 'results
.nSearched = 0 'results
End With

Call SearchForFiles(fp.sFileRoot)


End Sub

Private Sub SearchForFiles(sRoot As String)

Dim WFD As WIN32_FIND_DATA
Dim hFile As Long
Dim oCurApp As Access.Application
Dim oCurDB As DAO.Database
Dim oAccQuery As DAO.QueryDef
Dim sPath As String, sMDB As String
Dim sDBfind As String, sDSNReplace As String
Dim sDBReplace As String, sDBDelete As String
Dim sDBTableReplace As String


On Error GoTo Err_SearchForFiles

hFile = FindFirstFile(sRoot & ALL_FILES, WFD)

If hFile <> INVALID_HANDLE_VALUE Then

Do

'if a folder, and recurse specified, call
'method again
If (WFD.dwFileAttributes And vbDirectory) Then
If Asc(WFD.cFileName) <> vbDot Then

If fp.bRecurse Then
SearchForFiles sRoot & TrimNull(WFD.cFileName) &
vbBackslash
End If
End If

Else

'must be a file..
If MatchSpec(WFD.cFileName, fp.sFileNameExt) Then
fp.nCount = fp.nCount + 1
Debug.Print String$(40, "-")
Debug.Print sRoot & TrimNull(WFD.cFileName)
Debug.Print String$(40, "-")
If sPath & sMDB <> CurrentDb.Name Then
Set oCurApp = New Access.Application
Set oCurDB = oCurApp.DBEngine.OpenDatabase(sRoot &
TrimNull(WFD.cFileName))
sDbname = oCurDB.Name
'Call MakeTablesDSNLess(oCurDB)
Call FixPathInMacros(oCurApp)
oCurDB.Close
oCurApp.Quit acQuitSaveNone
Set oCurDB = Nothing
Set oCurApp = Nothing
End If

End If 'If MatchSpec

End If 'If WFD.dwFileAttributes

fp.nSearched = fp.nSearched + 1

Loop While FindNextFile(hFile, WFD)

End If 'If hFile

Call FindClose(hFile)

Exit Sub

Err_SearchForFiles:
Stop
Debug.Print "Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & vbCrLf & _
"Error Source: " & Err.Source
'Resume Next

End Sub


Sub FixPathInMacros(oCurApp As Access.Application)
Dim obj As AccessObject, dbs As Object
Set dbs = oCurApp.CurrentProject
' Search for open AccessObject objects in AllMacros collection.
For Each obj In dbs.AllMacros
'If obj.IsLoaded = True Then
' Print name of obj.
Debug.Print dbs.Name & "_" & obj.Name
'SaveAsText acMacro, obj.Name, "C:\Temp\" & obj.Name & ".txt"
'FixPath "C:\Temp\" & obj.Name & ".txt", "\\\\Server\\Folder\\"
'LoadFromText acMacro, obj.Name, "C:\Temp\" & obj.Name & ".txt"
'End If
Next obj
End Sub
 
Replace

Set oCurApp = New Access.Application
Set oCurDB = oCurApp.DBEngine.OpenDatabase(sRoot &
TrimNull(WFD.cFileName))
sDbname = oCurDB.Name

with

Set oCurApp = New Access.Application
sDbname = oCurDB.Name = sRoot &
TrimNull(WFD.cFileName))
oCurApp.OpenCurrentDatabase sDBName

Get rid of the lines

Dim oCurDB As DAO.Database

oCurDB.Close
and
Set oCurDB = Nothing
 
Douglas said:
Replace

Set oCurApp = New Access.Application
Set oCurDB = oCurApp.DBEngine.OpenDatabase(sRoot &
TrimNull(WFD.cFileName))
sDbname = oCurDB.Name

with

Set oCurApp = New Access.Application
sDbname = oCurDB.Name = sRoot &
TrimNull(WFD.cFileName))
oCurApp.OpenCurrentDatabase sDBName

Get rid of the lines

Dim oCurDB As DAO.Database

oCurDB.Close
and
Set oCurDB = Nothing
Click to expand...

Thanks Doug. I'm still getting that same "Error 2467: The expression you
entered refers to an object that is closed or doesn't exist." as soon as
it hits the for each loop in Sub FixPathInMacros.

Also, I'm assuming you wanted this line:
sDbname = oCurDB.Name = sRoot & TrimNull(WFD.cFileName))
to be
sDbname = sRoot & TrimNull(WFD.cFileName))
since oCurDB is no longer defined.


Matt
 
Matt Williamson said:
Thanks Doug. I'm still getting that same "Error 2467: The expression you
entered refers to an object that is closed or doesn't exist." as soon as
it hits the for each loop in Sub FixPathInMacros.

Also, I'm assuming you wanted this line:
sDbname = oCurDB.Name = sRoot & TrimNull(WFD.cFileName))
to be
sDbname = sRoot & TrimNull(WFD.cFileName))
since oCurDB is no longer defined.
Click to expand...

You're correct that my copy-and-paste job was sloppy.

Did you read Dirk's comment about how the code in your FixPathInMacros is
incorrect? (Since he'd already posted that, I just ignored that routine...)

I believe this should work:

Sub FixPathInMacros(oCurApp As Access.Application)
Dim dbExternal As DAO.Database
Dim colMacros As Documents
Dim docMacro As Document

Set dbExternal = oCurApp.CurrentDb
For Each docMacro In dbExternal.Containers("Scripts").Documents
' Print name of obj.
Debug.Print dbExternal.Name & "_" & docMacro.Name
'SaveAsText acMacro, docMacro.Name, "C:\Temp\" & docMacro.Name &
".txt"
'FixPath "C:\Temp\" & docMacro.Name & ".txt", "\\\\Server\\Folder\\"
'LoadFromText acMacro, docMacro.Name, "C:\Temp\" & docMacro.Name &
".txt"
Next docMacro
End Sub

Note, though, I think you'll need to delete the existing macro before
importing it back in. Otherwise, you'll import AutoExec as AutoExec1
 
Did you read Dirk's comment about how the code in your
FixPathInMacros > is
incorrect? (Since he'd already posted that, I just ignored that
routine...)
Click to expand...

I only see one reply from Dirk but it didn't say anything about the code
in my FixPathInMacros routine. I'm accessing the MSNEWS servers
directly from my reader so it should be updating pretty fast. It isn't
on Google yet either.
I believe this should work:

Sub FixPathInMacros(oCurApp As Access.Application)
Dim dbExternal As DAO.Database
Dim colMacros As Documents
Dim docMacro As Document

Set dbExternal = oCurApp.CurrentDb
For Each docMacro In dbExternal.Containers("Scripts").Documents
' Print name of obj.
Debug.Print dbExternal.Name & "_" & docMacro.Name
'SaveAsText acMacro, docMacro.Name, "C:\Temp\" & docMacro.Name &
".txt"
'FixPath "C:\Temp\" & docMacro.Name & ".txt", "\\\\Server\\Folder\\"
'LoadFromText acMacro, docMacro.Name, "C:\Temp\" & docMacro.Name &
".txt"
Next docMacro
End Sub

Note, though, I think you'll need to delete the existing macro before
importing it back in. Otherwise, you'll import AutoExec as AutoExec1
Click to expand...

When I plug in your new version of FixPathInMacros I get trusty error 91
as soon as I step in the Loop

Error Number: 91
Error Description: Object variable or With block variable not set
Error Source: Access9db
 
Matt Williamson said:
I only see one reply from Dirk but it didn't say anything about the code
in my FixPathInMacros routine. I'm accessing the MSNEWS servers directly
from my reader so it should be updating pretty fast. It isn't on Google
yet either.


When I plug in your new version of FixPathInMacros I get trusty error 91
as soon as I step in the Loop

Error Number: 91
Error Description: Object variable or With block variable not set
Error Source: Access9db
Click to expand...

Odd. It works for me. Given what you posted earlier, though, that error may
have nothing to do with the code I gave you, since there's no error handling
in FixPathInMacros. You may have to single-step through your code in order
to determine what's causing the error.
 
Odd. It works for me. Given what you posted earlier, though, that error may
have nothing to do with the code I gave you, since there's no error handling
in FixPathInMacros. You may have to single-step through your code in order
to determine what's causing the error.
Click to expand...

I have. When it hits Set dbExternal = oCurApp.CurrentDB
oCurApp.CurrentDB isn't populated. So I made the new app instance
visible and see that it's running the autoexec macro and closing before
the call to FixPathInMacros so the app instance is never passed to the
routine. I've tried the 'Sendkeys +' trick to stop the Autoexec just
before the call to OpenCurrentDatabase but it didn't work. Any other
tricks to stop the Autoexec macro? All of the DB's I'm working on have
them and they all run some imports and then close automatically.

TIA

Matt
 
Odd. It works for me. Given what you posted earlier, though, that error may
have nothing to do with the code I gave you, since there's no error handling
in FixPathInMacros. You may have to single-step through your code in order
to determine what's causing the error.
Click to expand...

I have. When it hits Set dbExternal = oCurApp.CurrentDB
oCurApp.CurrentDB isn't populated. So I made the new app instance
visible and see that it's running the autoexec macro and closing before
the call to FixPathInMacros so the app instance is never passed to the
routine. I've tried the 'Sendkeys +' trick to stop the Autoexec just
before the call to OpenCurrentDatabase but it didn't work. Any other
tricks to stop the Autoexec macro? All of the DB's I'm working on have
them and they all run some imports and then close automatically.

BTW. I still don't see that reply from Dirk that you mentioned. Can you
copy it into your reply so I can see what he said. It should have
populated on the MSNews servers by now. It isn't in the google archive
yet either.

TIA

Matt
 
Matt Williamson said:
BTW. I still don't see that reply from Dirk that you mentioned. Can you
copy it into your reply so I can see what he said. It should have
populated on the MSNews servers by now. It isn't in the google archive yet
either.
Click to expand...


Matt -

I think you saw my only reply. All it said was that the DAO database object
doesn't have an Application object -- and hence your code in
FixPathInMacros() couldn't be applied directly to a database object opened
with the DAO OpenDatabase method.
 
Dirk Goldgar said:
Matt -

I think you saw my only reply. All it said was that the DAO database
object doesn't have an Application object -- and hence your code in
FixPathInMacros() couldn't be applied directly to a database object opened
with the DAO OpenDatabase method.
Click to expand...

Exactly.
 
Matt Williamson said:
So I made the new app instance visible and see that it's running the
autoexec macro and closing before the call to FixPathInMacros so the app
instance is never passed to the routine. I've tried the 'Sendkeys +' trick
to stop the Autoexec just before the call to OpenCurrentDatabase but it
didn't work.
Click to expand...

Did you ensure that the application was visible and had the focus before
using SendKeys, as described here:

http://support.microsoft.com/?id=147816

?

Maybe it didn't work because you did it wrong, or maybe these applications
have their AllowBypassKey property set to False, which would keep that from
working.
 
Matt Williamson said:
I have. When it hits Set dbExternal = oCurApp.CurrentDB oCurApp.CurrentDB
isn't populated. So I made the new app instance visible and see that it's
running the autoexec macro and closing before the call to FixPathInMacros
so the app instance is never passed to the routine. I've tried the
'Sendkeys +' trick to stop the Autoexec just before the call to
OpenCurrentDatabase but it didn't work. Any other tricks to stop the
Autoexec macro? All of the DB's I'm working on have them and they all run
some imports and then close automatically.
Click to expand...

Refresh my memory. I can't find the KB article that talks about how to stop
the AutoExec (or start up form) from firing when Automating, but I do recall
that it involved Sendkeys. Exactly what have you put into your code?
 
Dirk said:
Did you ensure that the application was visible and had the focus before
using SendKeys, as described here:

http://support.microsoft.com/?id=147816
Click to expand...

Yep. Don't know what the deal is. I'm running Access 2003 under Win7 RC.
I tried it before and after with Wait set to True, etc. It just
didn't register.
Maybe it didn't work because you did it wrong, or maybe these
applications have their AllowBypassKey property set to False, which
would keep that from working.
Click to expand...

AllowBypassKey is True. I can hold down the Shift key before running the
code and it works fine. I started writing a function to do a global
hotkey keypress of shift when I came across this:
http://www.mvps.org/access/api/api0068.htm
I've seen no mention of it whatsoever in any of the NG postings I
searched through but it's a great function and works perfectly. The API
bit was along the lines of what I was working on already but passing it
through a function that creates a new app instance is a great way to
implement it, my hat's off to Dev for this. It seems to be working now.
Thanks to you and Doug for all of your help.

Matt
 
Matt Williamson said:
I started writing a function to do a global hotkey keypress of shift when
I came across this: http://www.mvps.org/access/api/api0068.htm
I've seen no mention of it whatsoever in any of the NG postings I searched
through but it's a great function and works perfectly. The API bit was
along the lines of what I was working on already but passing it through a
function that creates a new app instance is a great way to implement it,
my hat's off to Dev for this. It seems to be working now.
Click to expand...

Terrific! I didn't know that was there.
Thanks to you and Doug for all of your help.
Click to expand...

Well, we tried. Doug did most of the actual helping.
 
Back
Top