[AccessD] CreateObject ("Access.Application") is not working

Jim Dettman jimdettman at verizon.net
Mon Dec 10 14:47:56 CST 2012


William,

 <<I did think I needed to start Access if I could get
to the dbEngine object directly however I was looking for a reason as to
why, should I try to hook the DBEngine, I might not be able to. So I wanted
to be sure Access itself could be launched.>>

 I wouldn't bother firing up Access.

 You *can* instantiate dbEngine on it's own through the DAO lib, but
normally you only do that from something like C++.  Since Access carries a
dbEngine object of its own for the current database, there's no reason to do
that if Access is installed.  Without Access, you can only read/write data
in the tables of the DB. You won't have access to any Access objects, such
as forms, reports, etc. with the dbEngine alone.  If the intent though is
just to work with data and you want as little overhead as possible, then
that is what you'd do.


<<And it requires that there be a database path to try to
open. I am not sure why there is no way to just launch access and have it
sitting there in the background, without a database (Does
CreateObject doesn't usually require a target "document" but maybe
databases are different?)>>

  You can have that - it's just the way this procedure is written.

  If you do CreateObject ("Access.Application") you have an instance of
Access, but no DB as yet.  You would use the OpenCurrentDatabase() method to
open a DB within the instance as the "current" DB.

 Hope that helps; not sure if I'm missing the point or not<g>   I've been up
33 hours straight now and I haven't done that in a LONG time.

Jim.
 

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of William Benson
Sent: Monday, December 10, 2012 02:59 PM
To: Access Developers discussion and problem solving
Subject: Re: [AccessD] CreateObject ("Access.Application") is not working

Thanks for the replies. I did think I needed to start Access if I could get
to the dbEngine object directly however I was looking for a reason as to
why, should I try to hook the DBEngine, I might not be able to. So I wanted
to be sure Access itself could be launched. Below my function which
follows, is some code from Wayne Phillips, I don't know what it is doing
but it digs into the registry to see which version of Access to launch via
a shell, I think. And it requires that there be a database path to try to
open. I am not sure why there is no way to just launch access and have it
sitting there in the background, without a database (Does
CreateObject doesn't usually require a target "document" but maybe
databases are different?)

Below, I make use of some code from Wayne Phillips to check if Access can
be launched. If it is not already. If it can be, I quit it, since it was me
who launched it. If it was already running, I'll know via GetObject.

Then after I have surety that Access can be launched, I try to use DBEngine.

If I can't then that must be due to reference issues which I am not skilled
enough to overcome as of now but I wanted to at least get to a diagnosis.
The machine I have, does have access, and I can't test this on a lot of
environments.

'My function
Public Function GetDB(strLoc As String) As Object
Dim Ac As Object
Dim GetDBEngine As Object
Dim strName As String
Dim bUseDBE As Boolean

On Error Resume Next
Set Ac = GetObject(, "Access.Application")
If Ac Is Nothing Then
    Set Ac = CreateAccessInstance("Access.Application.15", strLoc)
    If Ac Is Nothing Then
        Set Ac = CreateAccessInstance("Access.Application.14", strLoc)
        If Ac Is Nothing Then
            Set Ac = CreateAccessInstance("Access.Application.12", strLoc)
            If Ac Is Nothing Then
                If UCase(Right(strLoc, 6)) = ".ACCDB" Then
                    'No sense trying to use DBEngine
                    Exit Function
                End If
            End If
        End If
    End If
    If Not Ac Is Nothing Then
        Debug.Print "We started Access, we can kill it"
        Ac.Quit
        bUseDBE = True
    End If
Else
    bUseDBE = True
End If
If bUseDBE Then
    Err.Clear
    Debug.Print "Trying to get the target through the DBEngine, and no
other db was open"
    'try 120
    Err.Clear
    Set GetDBEngine = CreateObject("DAO.DBEngine.120")
    If Err.Number <> 0 Then 'try 36
      Err.Clear
      Set GetDBEngine = CreateObject("DAO.DBEngine.36")
      If Err.Number <> 0 Then
        Set GetDBEngine = CreateObject("DAO.DBEngine.35")
      End If
    End If
    If Not GetDBEngine Is Nothing Then
        Set GetDB = GetDBEngine.Workspaces(0).OpenDatabase(strLoc)
    End If
End If
If bUseDBE And GetDB Is Nothing Then
    'Something is wrong - we can start and/or had an instance of Access but
    'cannot hook the database engine
    MsgBox "There is a problem with launching the database engine"
ElseIf Not bUseDBE Then
    Err.Clear
    Debug.Print "Trying to get the target through the DBEngine, and no
other db was open"
    'try 120
    Err.Clear
    Set GetDBEngine = CreateObject("DAO.DBEngine.120")
    If Err.Number <> 0 Then 'try 36
      Err.Clear
      Set GetDBEngine = CreateObject("DAO.DBEngine.36")
      If Err.Number <> 0 Then
        Set GetDBEngine = CreateObject("DAO.DBEngine.35")
      End If
    End If
    If Not GetDBEngine Is Nothing Then
        Set GetDB = GetDBEngine.Workspaces(0).OpenDatabase(strLoc)
    End If
    If GetDB Is Nothing Then
        MsgBox "Cannot find Access on this machine nor do the libraries for
DAO appear to be installed or registered within this application."
    End If
End If

End Function


Option Explicit

' ModCreateOfficeInstance by Wayne Phillips 2005 - C EverythingAccess.com
' Written on 23/11/2005 for automating a specific version of Access
' Updated on 07/03/2012 to allow for delayed binding and better error
handling.

Private Declare Function RegCloseKey Lib "advapi32" _
                        (ByVal hKey As Long) As Long

Private Declare Function RegOpenKey Lib "advapi32" _
                         Alias "RegOpenKeyA" _
                        (ByVal hKey As Long, _
                         ByVal sSubKey As String, _
                         hKey As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32" _
                         Alias "RegQueryValueExA" _
                        (ByVal hKey As Long, _
                         ByVal sKeyValue As String, _
                         ByVal lpReserved As Long, _
                         lpType As Long, _
                         lpData As Any, _
                         nSizeData As Long) As Long

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Function FnGetRegString(ByVal hKeyRoot As Long, _
                        ByVal strSubKey As String, _
                        ByVal strValueName As String, _
                        ByRef strRetVal As String) As Boolean

    Dim lngDataSize As Long
    Dim hKey As Long

    Const ERROR_MORE_DATA = 234
    Const ERROR_SUCCESS = 0

    strRetVal = ""

    If RegOpenKey(hKeyRoot, _
                 strSubKey, _
                 hKey) = ERROR_SUCCESS Then

        'Calculate the length of string we need to initialize as a buffer...
        If RegQueryValueEx(hKey, _
                         strValueName, _
                         0&, _
                         0&, _
                         ByVal strRetVal, _
                         lngDataSize) = ERROR_MORE_DATA Then

            'Initialize the string buffer to a fixed length
            strRetVal = String(lngDataSize + 1, 0)

            If RegQueryValueEx(hKey, _
                        strValueName, _
                        0&, _
                        0&, _
                        ByVal strRetVal, _
                        lngDataSize) = ERROR_SUCCESS Then

                'We got the value, trim the extra null terminator
                strRetVal = Left(strRetVal, InStr(1, strRetVal, Chr(0)) - 1)
                FnGetRegString = True

            End If

        End If

        Call RegCloseKey(hKey)

    End If

End Function

Private Function FnGetAssociatedPathFromProgID(ByVal strProgID As String)
As String

    Dim strOutputPath As String

    Const HKEY_CLASSES_ROOT = &H80000000

    If FnGetRegString(HKEY_CLASSES_ROOT, strProgID & "\shell\Open\command",
"", strOutputPath) = True Then
        FnGetAssociatedPathFromProgID = strOutputPath
    End If

End Function

Public Function CreateOfficeInstance(ByVal strProgID As String, _
                            ByVal strFilePath) As Object

    Dim strCommandLine As String
    Dim strPath As String

    'Get the class GUID (CLSID) from the input ProgID
    strPath = FnGetAssociatedPathFromProgID(strProgID)

    If Len(strPath) > 0 Then

        'The returned path is actually a command line string with parameter
for file name as %1
        strCommandLine = Replace(strPath, "%1", strFilePath)

        Shell strCommandLine, vbMinimizedNoFocus

        'Attempt to bind to the instance...
        On Error GoTo RetryDelay
        Set CreateOfficeInstance = GetObject(strFilePath).Application

    Else

        Err.Raise 76, , "CreateOfficeInstance: failed to get path
information for ProgID '" & strProgID & "'"

    End If

    Exit Function

RetryDelay:

    ' Binding to the created instance might fail if the external process
hasn't yet loaded the
    ' document / file and registered itself in the COM Running Object
Table, so we will retry
    ' several times after a short delay, before failing.

    Dim RetryCount As Long
    If RetryCount < 10 Then
        Sleep 500   ' Wait half a second and try again (upto 10 times)
        RetryCount = RetryCount + 1
        Resume
    Else
        On Error GoTo 0
        Err.Raise 429, , "CreateOfficeInstance: failed to bind to specific
instance of '" & strProgID & "'"
    End If

End Function
-- 
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com



More information about the AccessD mailing list