Pop-up Filter Selection 
Author Message
 Pop-up Filter Selection

When we use a drop down menu to select a file, windows has
a filter that pops up that shows the user which
extension one can select (for example, all files, .txt,
mdb, mda, etc).

Does anyone knows how I can call this filter window up???  
It may required an API call.  I want to use it in one of my
custom forms in Access.

Your help is deeply appreciated.

Thank You,

Gary



Tue, 02 Aug 2005 00:07:40 GMT  
 Pop-up Filter Selection
Yes, you can select the filter.

Following is a common-dialog button I use when I ask the
user to find the server-side database to link to.

After that is a copy of the supporting routines.

Private Sub cmdCommDlg_Click()
On Error GoTo Err_cmdCommDlg_Click

    Dim strFilename As String
    Dim strTitle As String
    Dim strFilter As String

    ' Prepare the data for the common dialog
    strTitle = "Find Remote Database"
    strFilter = "Microsoft Access (*.mdb)|*.mdb|All (*.*)
|*.*"

    ' Get the filename
    strFilename = OpenCommDlg(strTitle, strFilter)

    ' Set it in the box
    If strFilename <> "" Then txtFilename = strFilename

Exit_cmdCommDlg_Click:
    Exit Sub

Err_cmdCommDlg_Click:

ErrorHandler "Form_frmDocumentAdd", "cmdCommDlg_Click",
Err.Number, Err.Description
    Resume Exit_cmdCommDlg_Click

End Sub

Option Compare Database
Option Explicit

' GetFileNameInfo flags
Public Const niConfirmReplace = &H1         ' Prompt if
overwriting a file?
Public Const niNoChangeDir = &H2            ' Disable the
read-only option
Public Const niAllowReadOnly = &H4          ' Don't change
to the directory the user selected?
Public Const niAllowMultiSelect = &H8       ' Allow
multiple-selection?
Public Const niDirectoryOnly = &H20         ' Open as
directory picker?
Public Const niInitializeView = &H40        ' Initialize
the view to the lView member or use last selected view?

Type OfficeGetFileNameInfo
    hwndOwner As Long
    strAppName As String * 255
    strDlgTitle As String * 255
    strOpenTitle As String * 255
    strFile As String * 4096
    strInitialDir As String * 255
    strFilter As String * 255
    lngFilterIndex As Long
    lngView As Long
    lngFlags As Long
End Type

Declare Function OfficeGetFileName Lib "msaccess.exe"
Alias "#56" (gfni As OfficeGetFileNameInfo, ByVal fOpen As
Integer) As Long

Function OpenCommDlg(strTitle As String, strFilter As
String) As String
On Error GoTo Err_OpenCommDlg

    Dim gfni As OfficeGetFileNameInfo
    Dim lngAPIResult As Long

    With gfni

        gfni.hwndOwner = Screen.ActiveForm.hwnd

        gfni.strAppName = CurrentDb.Name
        If strTitle = "" Then gfni.strDlgTitle = "Open"
Else gfni.strDlgTitle = strTitle
        gfni.strOpenTitle = "Open"
        gfni.strFile = ""

        ' Define a default filter string
        If strFilter = "" Then
            gfni.strFilter = "Microsoft Access (*.mdb)
|*.mdb|All (*.*)|*.*"
        Else
            gfni.strFilter = strFilter
        End If

        ' Set up the default directory
        gfni.strInitialDir = CurDir$

        ' Prepare the inputs
        .strAppName = RTrim(.strAppName) & vbNullChar
        .strDlgTitle = RTrim(.strDlgTitle) & vbNullChar
        .strOpenTitle = RTrim(.strOpenTitle) & vbNullChar
        .strFile = RTrim(.strFile) & vbNullChar
        .strInitialDir = RTrim(.strInitialDir) & vbNullChar
        .strFilter = RTrim(.strFilter) & vbNullChar
        SysCmd acSysCmdClearHelpTopic

        ' Open the common dialog
        lngAPIResult = OfficeGetFileName(gfni, True)

        ' Return the file name
        .strFile = TrimNull(.strFile)
        OpenCommDlg = Trim(.strFile)            ' Return
the result
    End With

Exit_OpenCommDlg:
    Exit Function

Err_OpenCommDlg:
    ErrorHandler "modCommonDialog", "OpenCommDlg",
Err.Number, Err.Description
    Resume Exit_OpenCommDlg

End Function

Function SaveCommDlg(strTitle As String, strFilter As
String) As String
On Error GoTo Err_SaveCommDlg

    Dim gfni As OfficeGetFileNameInfo
    Dim lngAPIResult As Long

    With gfni

        gfni.hwndOwner = Screen.ActiveForm.hwnd

        gfni.strAppName = CurrentDb.Name
        If strTitle = "" Then gfni.strDlgTitle = "Save"
Else gfni.strDlgTitle = strTitle
        gfni.strOpenTitle = "Save"
        gfni.strFile = ""

        ' Define a default filter string
        If strFilter = "" Then
            gfni.strFilter = "Microsoft Access (*.mdb)
|*.mdb|All (*.*)|*.*"
        Else
            gfni.strFilter = strFilter
        End If

        ' Set up the default directory
        gfni.strInitialDir = CurDir$

        ' Prepare the inputs
        .strAppName = RTrim(.strAppName) & vbNullChar
        .strDlgTitle = RTrim(.strDlgTitle) & vbNullChar
        .strOpenTitle = RTrim(.strOpenTitle) & vbNullChar
        .strFile = RTrim(.strFile) & vbNullChar
        .strInitialDir = RTrim(.strInitialDir) & vbNullChar
        .strFilter = RTrim(.strFilter) & vbNullChar
        .lngFlags = niConfirmReplace                '
Confirm replacement of a file
        SysCmd acSysCmdClearHelpTopic

        ' Open the common dialog
        lngAPIResult = OfficeGetFileName(gfni, True)

        ' Return the file name
        .strFile = TrimNull(.strFile)
        SaveCommDlg = Trim(.strFile)            ' Return
the result
    End With

Exit_SaveCommDlg:
    Exit Function

Err_SaveCommDlg:
    ErrorHandler "modCommonDialog", "SaveCommDlg",
Err.Number, Err.Description
    Resume Exit_SaveCommDlg

End Function

Function GetDirectory(strTitle As String) As String
On Error GoTo Err_GetDirectory

    Dim gfni As OfficeGetFileNameInfo
    Dim lngAPIResult As Long

    With gfni

        gfni.hwndOwner = Screen.ActiveForm.hwnd

        gfni.strAppName = CurrentDb.Name
        If strTitle = "" Then gfni.strDlgTitle = "Select
Directory" Else gfni.strDlgTitle = strTitle
        gfni.strOpenTitle = "Select"
        gfni.strFile = ""

        ' Set up the default directory
        gfni.strInitialDir = CurDir$

        ' Prepare the inputs
        .strAppName = RTrim(.strAppName) & vbNullChar
        .strDlgTitle = RTrim(.strDlgTitle) & vbNullChar
        .strOpenTitle = RTrim(.strOpenTitle) & vbNullChar
        .strFile = RTrim(.strFile) & vbNullChar
        .strInitialDir = RTrim(.strInitialDir) & vbNullChar
        .strFilter = RTrim(.strFilter) & vbNullChar
        .lngFlags = niDirectoryOnly                 ' Only
return the directory
        SysCmd acSysCmdClearHelpTopic

        ' Open the common dialog
        lngAPIResult = OfficeGetFileName(gfni, True)

        ' Return the file name
        .strFile = TrimNull(.strFile)
        GetDirectory = Trim(.strFile)            ' Return
the result
    End With

Exit_GetDirectory:
    Exit Function

Err_GetDirectory:
    ErrorHandler "modCommonDialog", "GetDirectory",
Err.Number, Err.Description
    Resume Exit_GetDirectory

End Function

Function TrimNull(strVal As String) As String
On Error GoTo Err_TrimNull

    ' Trim the end of a string, stopping at the first null
character.
    Dim intPos As Integer

    ' Return the location of the first null character
    intPos = InStr(strVal, vbNullChar)

    ' Return the string up to the null
    If intPos > 0 Then
        TrimNull = Left$(strVal, intPos - 1)
    Else
        TrimNull = strVal
    End If

Exit_TrimNull:
    Exit Function

Err_TrimNull:
    ErrorHandler "modCommonDialog", "TrimNull",
Err.Number, Err.Description
    Resume Exit_TrimNull

End Function



Tue, 02 Aug 2005 00:57:03 GMT  
 
 [ 2 post ] 

 Relevant Pages 

1. Pop-ups in MS Office

2. pop-ups

3. Pop-ups in TreeView

4. downloading file without pop-ups

5. Pop-ups

6. Pop ups

7. control enumeration pop-ups at design time

8. Pop Ups

9. Filtering a form with a combo box selection

10. A VB Filter by Selection?

11. A VB Filter By Selection?

12. VBA ,Coding filter by selection

 

 
Powered by phpBB® Forum Software