Improve company productivity with a Business Account.Sign Up

  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 680
  • Last Modified:

Common dialog API causes problem

I am using the Windows API to dispaly a browse for file window and return the user's selection. I previously tried using the common dialog control, but quickly found that users could have trouble with the registration of this control on their PC's, so I obtained code (by Ken Getz) to use the Windows API from a Web site. The code is shown below. I call this code as follows:

  strFilter = ahtAddFilterItem(strFilter, "MS Access databases|*.mdb")
  strFilename = ahtCommonFileOpenSave(Filter:=strFilter, OpenFile:=True, _
    DialogTitle:="Enter path to the Franchisee Profiler data:", _
    InitialDir:=strDataPath, FileName:="FPData.mdb", Flags:=ahtOFN_HIDEREADONLY)
  If strFilename = "" Then
    'Error - user pressed cancel
    'continue with returned pathname in strFileName

When my client tries to run the application on his computer, the common dialog code runs fine. He selects the path to the backend database, and then all is OK until he closes and reopens the app. This time the tables are linked correctly, so the common dialog box does not show at startup (although it is still used to perform an import/export function if desired). However, whenever he opens a report or runs a query that uses the Format function, he is either prompted for parameter value "Format", or he receives a message "The expression is typed incorrectly, or it is too complex to be evaluated. For example, a numeric expression may contain too many complicated elements. Try simplifying the expression by assigning part of the expression to variables.".
No references are missing and the application compiles OK, but somehow the Format function is no longer recognised. There is no reference to comdlg32.dll - I presume that it is part of Windows and always guaranteed to be present.

I thought that using the Windows API was supposed to solve all problems with installation, but since this code uses the library comdlg32.dll and there are differenet versions of that, I'm not so sure.
I am at a loss to know what to do - all help would be appreciated.

Here is the API code:

'***************** Code Start **************
'This code was originally written by Ken Getz.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
' Code courtesy of:
'    Microsoft Access 95 How-To
' Ken Getz and Paul Litwin
' Waite Group Press, 1996

    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    strFilter As String
    strCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    strFile As String
    nMaxFile As Long
    strFileTitle As String
    nMaxFileTitle As Long
    strInitialDir As String
    strTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    strDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
    Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean

Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
    Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
' You won't use these.
'Global Const ahtOFN_ENABLEHOOK = &H20
'Global Const ahtOFN_ENABLETEMPLATE = &H40
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
' New for Windows 95
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000

Function ahtCommonFileOpenSave( _
            Optional ByRef Flags As Variant, _
            Optional ByVal InitialDir As Variant, _
            Optional ByVal Filter As Variant, _
            Optional ByVal FilterIndex As Variant, _
            Optional ByVal DefaultExt As Variant, _
            Optional ByVal FileName As Variant, _
            Optional ByVal DialogTitle As Variant, _
            Optional ByVal hwnd As Variant, _
            Optional ByVal OpenFile As Variant) As Variant
' This is the entry point you'll use to call the common
' file open/save dialog. The parameters are listed
' below, and all are optional.
' In:
' Flags: one or more of the ahtOFN_* constants, OR'd together.
' InitialDir: the directory in which to first look
' Filter: a set of file filters, set up by calling
' AddFilterItem. See examples.
' FilterIndex: 1-based integer indicating which filter
' set to use, by default (1 if unspecified)
' DefaultExt: Extension to use if the user doesn't enter one.
' Only useful on file saves.
' FileName: Default value for the file name text box.
' DialogTitle: Title for the dialog.
' hWnd: parent window handle
' OpenFile: Boolean(True=Open File/False=Save As)
' Out:
' Return Value: Either Null or the selected filename
Dim strFilename As String
Dim strFileTitle As String
Dim fResult As Boolean
    ' Give the dialog a caption title.
    If IsMissing(InitialDir) Then InitialDir = CurDir
    If IsMissing(Filter) Then Filter = ""
    If IsMissing(FilterIndex) Then FilterIndex = 1
    If IsMissing(Flags) Then Flags = 0&
    If IsMissing(DefaultExt) Then DefaultExt = ""
    If IsMissing(FileName) Then FileName = ""
    If IsMissing(DialogTitle) Then DialogTitle = ""
    If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
    If IsMissing(OpenFile) Then OpenFile = True
    ' Allocate string space for the returned strings.
    strFilename = Left(FileName & String(256, 0), 256)
    strFileTitle = String(256, 0)
    ' Set up the data structure before you call the function
    With OFN
        .lStructSize = Len(OFN)
        .hwndOwner = hwnd
        .strFilter = Filter
        .nFilterIndex = FilterIndex
        .strFile = strFilename
        .nMaxFile = Len(strFilename)
        .strFileTitle = strFileTitle
        .nMaxFileTitle = Len(strFileTitle)
        .strTitle = DialogTitle
        .Flags = Flags
        .strDefExt = DefaultExt
        .strInitialDir = InitialDir
        ' Didn't think most people would want to deal with
        ' these options.
        .hInstance = 0
        '.strCustomFilter = ""
        '.nMaxCustFilter = 0
        .lpfnHook = 0
        'New for NT 4.0
        .strCustomFilter = String(255, 0)
        .nMaxCustFilter = 255
    End With
    ' This will pass the desired data structure to the
    ' Windows API, which will in turn it uses to display
    ' the Open/Save As Dialog.
    If OpenFile Then
        fResult = aht_apiGetOpenFileName(OFN)
        fResult = aht_apiGetSaveFileName(OFN)
    End If

    ' The function call filled in the strFileTitle member
    ' of the structure. You'll have to write special code
    ' to retrieve that if you're interested.
    If fResult Then
        ' You might care to check the Flags member of the
        ' structure to get information about the chosen file.
        ' In this example, if you bothered to pass in a
        ' value for Flags, we'll fill it in with the outgoing
        ' Flags value.
        If Not IsMissing(Flags) Then Flags = OFN.Flags
        ahtCommonFileOpenSave = TrimNull(OFN.strFile)
        ahtCommonFileOpenSave = vbNullString
    End If
End Function

Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
  intPos = InStr(strItem, vbNullChar)
  If intPos > 0 Then
      TrimNull = Left(strItem, intPos - 1)
      TrimNull = strItem
  End If

End Function

Function ahtAddFilterItem(strFilter As String, _
    strDescription As String, Optional varItem As Variant) As String
' Tack a new chunk onto the file filter.
' That is, take the old value, stick onto it the description,
' (like "Databases"), a null character, the skeleton
' (like "*.mdb;*.mda") and a final null character.

    If IsMissing(varItem) Then varItem = "*.*"
    ahtAddFilterItem = strFilter & _
                strDescription & vbNullChar & _
                varItem & vbNullChar
End Function

  • 2
1 Solution
When you said there are no missing references, was that on the development machine, or on the users machine that is running it, you must make sure anyone running it has the same libraries available to them.

Also, it may be a version problem with a library. I have encountered cases where I compile a DLL and it updates the ref on my machine, on another machine that has the old version of the dll this causes a problem with anything in access that uses the Format function (even though there is no references listed as Missing).

Sometimes, I have had to actually go into tools an references from the machine having the problem and uncheck all but the built in references, close the dialog, then reopen and reselect all the references (which in some cases actually causes the bad refernce to be removed from the list).
kmuntzAuthor Commented:
The references are not missing on the client's PC. However you are on the right track. In desperation I used code that I previously included in another app. I got this code from the Microsoft KB; it's supposed to solve a problem where inbuilt functions give errors after an Access97 runtime system is installed, but the user later upgrades his PC to Office 2000. The code tries to open a query that uses an inbuilt function such as Format, Left, etc. If it gets an error it drops all references and recreates them. From then on all is OK. It has worked for me in this case too. here is the code:

Function CheckRefs()
   Dim dbs As Database, rst As Recordset
   Set dbs = CurrentDb

   On Error Resume Next

   ' Run the query qryTestRefs which uses a built-in function and trap for an error.
   Set rst = dbs.OpenRecordset("qryTestRefs", dbOpenDynaset)

   ' The if statement below checks for error 3075. If it encounters the
   ' error, it informs the user that it needs to fix the application.
   ' Error 3075 is the following:
   ' "Function isn't available in expressions in query expression..."

   ' Note: This function only checks for the error 3075. If you want it to
   ' check for other errors, you can modify the If statement. To have
   ' it check for any error, you can change it to the following:
   ' If Err.Number <> 0

    If Err.Number <> 0 Then
    'If Err.Number = 3075 Then
      MsgBox "The program has detected a few files it needs to recompile on your " _
      & "computer. This should only take a few seconds. Thankyou for your patience. " _
      & vbCrLf & vbCrLf & "Please click OK to continue.", vbInformation
   End If

End Function

Sub FixUpRefs()
   Dim r As Reference, r1 As Reference
   Dim str As String

   ' Look for the first reference in the database other
   ' than Access and Visual Basic for Applications.
   For Each r In Application.References
      If r.Name <> "Access" And r.Name <> "VBA" Then
        Set r1 = r
        str = r1.FullPath
        ' Remove the Reference and add it back.
        References.Remove r1
        References.AddFromFile str
      End If

   ' Call a hidden SysCmd to automatically compile/save all modules.
   Call SysCmd(504, 16483)
End Sub

As you can see I check for any error, not just error 3075. I will award the points to blakeh1 for putting me on the right track, and making me realise that even though the references were not missing, there still could be a problem.
kmuntzAuthor Commented:
See my last posted comment.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Easily Design & Build Your Next Website

Squarespace’s all-in-one platform gives you everything you need to express yourself creatively online, whether it is with a domain, website, or online store. Get started with your free trial today, and when ready, take 10% off your first purchase with offer code 'EXPERTS'.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now