Solved

Common Dialog Box

Posted on 2002-04-19
18
480 Views
Last Modified: 2007-11-27
Is it possible to use the windows Dialog Box, the one which loads when someone tries to open a file,  using VB for Access?
0
Comment
Question by:bravismore
  • 8
  • 3
  • 2
  • +3
18 Comments
 
LVL 12

Expert Comment

by:James Elliott
Comment Utility
You can open it, Yes.

I'm not sure whether you can use it as a shell for your own devices.

Is that what you are asking?

0
 
LVL 15

Accepted Solution

by:
cquinn earned 15 total points
Comment Utility
Create a new Class module called clsCommonDialog and add this code:

Option Explicit

'API function called by ChooseColor method
Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long

'API function called by ChooseFont method
Private Declare Function CHOOSEFONT Lib "comdlg32.dll" Alias "ChooseFontA" (pChoosefont As CHOOSEFONT) As Long

'API function inside ShowHelp method
Private Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hWnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long

'API function called by ShowOpen method
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OpenFilename) As Long

'API function called by ShowSave method
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OpenFilename) As Long

'API function called by ShowPrint method
Private Declare Function PrintDlg Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PrintDlg) As Long


'API function to retrieve extended error information
Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

'API memory functions
Private Declare Function GlobalAlloc Lib "KERNEL32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "KERNEL32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "KERNEL32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "KERNEL32" (ByVal hMem As Long) As Long

Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" ( _
         hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
 

'constants for API memory functions
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
 
 
'data buffer for the ChooseColor function
Private Type ChooseColor
        lStructSize As Long
        hWndOwner As Long
        hInstance As Long
        rgbResult As Long
        lpCustColors As Long
        flags As Long
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
End Type

'constants for LOGFONT
Private Const LF_FACESIZE = 32
Private Const LF_FULLFACESIZE = 64
Private Const FW_BOLD = 700

'data buffer for the ChooseFont function
Private Type LOGFONT
        lfHeight As Long
        lfWidth As Long
        lfEscapement As Long
        lfOrientation As Long
        lfWeight As Long
        lfItalic As Byte
        lfUnderline As Byte
        lfStrikeOut As Byte
        lfCharSet As Byte
        lfOutPrecision As Byte
        lfClipPrecision As Byte
        lfQuality As Byte
        lfPitchAndFamily As Byte
        lfFaceName(LF_FACESIZE) As Byte
End Type

'data buffer for the ChooseFont function
Private Type CHOOSEFONT
        lStructSize As Long
        hWndOwner As Long
        hDc As Long
        lpLogFont As Long
        iPointSize As Long
        flags As Long
        rgbColors As Long
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
        hInstance As Long
        lpszStyle As String
        nFontType As Integer
        MISSING_ALIGNMENT As Integer
        nSizeMin As Long
        nSizeMax As Long
End Type


'data buffer for the GetOpenFileName and GetSaveFileName functions
Private Type OpenFilename
        lStructSize As Long
        hWndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        iFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
End Type


'data buffer for the PrintDlg function
Private Type PrintDlg
        lStructSize As Long
        hWndOwner As Long
        hDevMode As Long
        hDevNames As Long
        hDc As Long
        flags As Long
        nFromPage As Integer
        nToPage As Integer
        nMinPage As Integer
        nMaxPage As Integer
        nCopies As Integer
        hInstance As Long
        lCustData As Long
        lpfnPrintHook As Long
        lpfnSetupHook As Long
        lpPrintTemplateName As String
        lpSetupTemplateName As String
        hPrintTemplate As Long
        hSetupTemplate As Long
End Type


'internal property buffers

Private iAction As Integer         'internal buffer for Action property
Private bCancelError As Boolean    'internal buffer for CancelError property
Private lColor As Long             'internal buffer for Color property
Private lCopies As Long            'internal buffer for lCopies property
Private sDefaultExt As String      'internal buffer for sDefaultExt property
Private sDialogTitle As String     'internal buffer for DialogTitle property
Private sFileName As String        'internal buffer for FileName property
Private sFileTitle As String       'internal buffer for FileTitle property
Private sFilter As String          'internal buffer for Filter property
Private iFilterIndex As Integer    'internal buffer for FilterIndex property
Private lFlags As Long             'internal buffer for Flags property
Private bFontBold As Boolean       'internal buffer for FontBold property
Private bFontItalic As Boolean     'internal buffer for FontItalic property
Private sFontName As String        'internal buffer for FontName property
Private lFontSize As Long          'internal buffer for FontSize property
Private bFontStrikethru As Boolean 'internal buffer for FontStrikethru property
Private bFontUnderline As Boolean  'internal buffer for FontUnderline property
Private lFromPage As Long          'internal buffer for FromPage property
Private lhdc As Long               'internal buffer for hdc property
Private lhwndOwner As Long              'internal buffer for hWnd property
Private lHelpCommand As Long       'internal buffer for HelpCommand property
Private sHelpContext As String     'internal buffer for HelpContext property
Private sHelpFile As String        'internal buffer for HelpFile property
Private sHelpKey As String         'internal buffer for HelpKey property
Private sInitDir As String         'internal buffer for InitDir property
Private lMax As Long               'internal buffer for Max property
Private lMaxFileSize As Long       'internal buffer for MaxFileSize property
Private lMin As Long               'internal buffer for Min property
Private objObject As Object        'internal buffer for Object property
Private iPrinterDefault As Integer 'internal buffer for PrinterDefault property
Private lToPage As Long            'internal buffer for ToPage property

Private lApiReturn As Long          'internal buffer for APIReturn property
Private lExtendedError As Long      'internal buffer for ExtendedError property



'constants for color dialog

Private Const CDERR_DIALOGFAILURE = &HFFFF
Private Const CDERR_FINDRESFAILURE = &H6
Private Const CDERR_GENERALCODES = &H0
Private Const CDERR_INITIALIZATION = &H2
Private Const CDERR_LOADRESFAILURE = &H7
Private Const CDERR_LOADSTRFAILURE = &H5
Private Const CDERR_LOCKRESFAILURE = &H8
Private Const CDERR_MEMALLOCFAILURE = &H9
Private Const CDERR_MEMLOCKFAILURE = &HA
Private Const CDERR_NOHINSTANCE = &H4
Private Const CDERR_NOHOOK = &HB
Private Const CDERR_NOTEMPLATE = &H3
Private Const CDERR_REGISTERMSGFAIL = &HC
Private Const CDERR_STRUCTSIZE = &H1


'constants for file dialog

Private Const FNERR_BUFFERTOOSMALL = &H3003
Private Const FNERR_FILENAMECODES = &H3000
Private Const FNERR_INVALIDFILENAME = &H3002
Private Const FNERR_SUBCLASSFAILURE = &H3001

Public Property Get Filter() As String
    'return object's Filter property
    Filter = sFilter
End Property

Public Sub ShowColor()
    'display the color dialog box
   
    Dim tChooseColor As ChooseColor
    Dim alCustomColors(15) As Long
    Dim lCustomColorSize As Long
    Dim lCustomColorAddress As Long
    Dim lMemHandle As Long
   
    Dim n As Integer
       
    On Error GoTo ShowColorError
   
   
    '***    init property buffers
   
    iAction = 3  'Action property - ShowColor
    lApiReturn = 0  'APIReturn property
    lExtendedError = 0  'ExtendedError property
   
   
    '***    prepare tChooseColor data
   
    'lStructSize As Long
    tChooseColor.lStructSize = Len(tChooseColor)
   
    'hwndOwner As Long
    tChooseColor.hWndOwner = lhwndOwner

    'hInstance As Long
   
    'rgbResult As Long
    tChooseColor.rgbResult = lColor
   
    'lpCustColors As Long
    ' Fill custom colors array with all white
    For n = 0 To UBound(alCustomColors)
        alCustomColors(n) = &HFFFFFF
    Next
    ' Get size of memory needed for custom colors
    lCustomColorSize = Len(alCustomColors(0)) * 16
    ' Get a global memory block to hold a copy of the custom colors
    lMemHandle = GlobalAlloc(GHND, lCustomColorSize)
   
    If lMemHandle = 0 Then
        Exit Sub
    End If
    ' Lock the custom color's global memory block
    lCustomColorAddress = GlobalLock(lMemHandle)
    If lCustomColorAddress = 0 Then
        Exit Sub
    End If
    ' Copy custom colors to the global memory block
    Call CopyMemory(ByVal lCustomColorAddress, alCustomColors(0), lCustomColorSize)
 
    tChooseColor.lpCustColors = lCustomColorAddress
   
    'flags As Long
    tChooseColor.flags = lFlags
       
    'lCustData As Long
    'lpfnHook As Long
    'lpTemplateName As String
   
   
    '***    call the ChooseColor API function
    lApiReturn = ChooseColor(tChooseColor)
   
   
    '***    handle return from ChooseColor API function
    Select Case lApiReturn
       
        Case 0  'user canceled
        If bCancelError = True Then
            'generate an error
            On Error GoTo 0
            Err.Raise Number:=vbObjectError + 894, _
                Description:="Cancel Pressed"
            Exit Sub
        End If
       
        Case 1  'user selected a color
            'update property buffer
            lColor = tChooseColor.rgbResult
       
        Case Else   'an error occured
            'call CommDlgExtendedError
            lExtendedError = CommDlgExtendedError
       
    End Select

Exit Sub

ShowColorError:
    Exit Sub
End Sub

Public Sub ShowFont()
    'display the font dialog box
   
    Dim tLogFont As LOGFONT
    Dim tChooseFont As CHOOSEFONT
   
    Dim lLogFontSize As Long
    Dim lLogFontAddress As Long
    Dim lMemHandle As Long
   
    Dim lReturn As Long
    Dim sFont As String
    Dim lBytePoint As Long
    On Error GoTo ShowFontError
   
    '***    init property buffers
   
    iAction = 4  'Action property - ShowFont
    lApiReturn = 0  'APIReturn property
    lExtendedError = 0  'ExtendedError property

   
    '***    prepare tChooseFont data
       
    'tLogFont.lfHeight As Long
    'tLogFont.lfWidth As Long
    'tLogFont.lfEscapement As Long
    'tLogFont.lfOrientation As Long
   
    'tLogFont.lfWeight As Long - init from FontBold property
    If bFontBold = True Then
        tLogFont.lfWeight = FW_BOLD
    End If
   
    'tLogFont.lfItalic As Byte - init from FontItalic property
    If bFontItalic = True Then
        tLogFont.lfItalic = 1
    End If
   
    'tLogFont.lfUnderline As Byte - init from FontUnderline property
    If bFontUnderline = True Then
        tLogFont.lfUnderline = 1
    End If

    'tLogFont.lfStrikeOut As Byte - init from FontStrikethru property
    If bFontStrikethru = True Then
        tLogFont.lfStrikeOut = 1
    End If

    'tLogFont.lfCharSet As Byte
    'tLogFont.lfOutPrecision As Byte
    'tLogFont.lfClipPrecision As Byte
    'tLogFont.lfQuality As Byte
    'tLogFont.lfPitchAndFamily As Byte
    'tLogFont.lfFaceName(LF_FACESIZE) As Byte
   
    'tChooseFont.lStructSize As Long
    tChooseFont.lStructSize = Len(tChooseFont)
   
    'tChooseFont.hwndOwner As Long
    'tChooseFont.hdc As Long
   
    'tChooseFont.lpLogFont As Long
    lLogFontSize = Len(tLogFont)
   
    ' Get a global memory block to hold a copy of tLogFont - exit on failure
    lMemHandle = GlobalAlloc(GHND, lLogFontSize)
    If lMemHandle = 0 Then
        Exit Sub
    End If
   
    ' Lock tLogFont's global memory block - exit on failure
    lLogFontAddress = GlobalLock(lMemHandle)
    If lLogFontAddress = 0 Then
        Exit Sub
    End If
   
    ' Copy tLogFont to the global memory block
    Call CopyMemory(ByVal lLogFontAddress, tLogFont, lLogFontSize)
 
    tChooseFont.lpLogFont = lLogFontAddress
   
    'tChooseFont.iPointSize As Long - init from FontSize property
    tChooseFont.iPointSize = lFontSize * 10
   
    'tChooseFont.flags As Long - init from Flags property
    tChooseFont.flags = lFlags

    'tChooseFont.rgbColors As Long
    'tChooseFont.lCustData As Long
    'tChooseFont.lpfnHook As Long
    'tChooseFont.lpTemplateName As String
    'tChooseFont.hInstance As Long
   
    'tChooseFont.lpszStyle As String
    'sFont = Chr$(0) & Space$(20) & Chr$(0)
    'tChooseFont.lpszStyle = sFont
   
    'tChooseFont.nFontType As Integer
    'tChooseFont.MISSING_ALIGNMENT As Integer
    'tChooseFont.nSizeMin As Long
    'tChooseFont.nSizeMax As Long
                   
   
    '***    call the CHOOSEFONT API function
    lApiReturn = CHOOSEFONT(tChooseFont)    'store to APIReturn property
   
   
    '***    handle return from CHOOSEFONT API function
    Select Case lApiReturn
       
        Case 0  'user canceled
        If bCancelError = True Then
            'generate an error
            Err.Raise (2001)
            Exit Sub
        End If
       
        Case 1  'user selected a font
            ' Copy global memory block to tLogFont
            Call CopyMemory(tLogFont, ByVal lLogFontAddress, lLogFontSize)
           
            'tLogFont.lfWeight As Long  - store to FontBold property
            If tLogFont.lfWeight >= FW_BOLD Then
                bFontBold = True
            Else
                bFontBold = False
            End If
                       
            'tLogFont.lfItalic As Byte - store to FontItalic property
            If tLogFont.lfItalic = 1 Then
                bFontItalic = True
            Else
                bFontItalic = False
            End If
           
            'tLogFont.lfUnderline As Byte - store to FontUnderline property
            If tLogFont.lfUnderline = 1 Then
                bFontUnderline = True
            Else
                bFontUnderline = False
            End If
       
            'tLogFont.lfStrikeOut As Byte - store to FontStrikethru property
            If tLogFont.lfStrikeOut = 1 Then
                bFontStrikethru = True
            Else
                bFontStrikethru = False
            End If
           
            'tLogFont.lfFaceName(LF_FACESIZE) As Byte - store to FontName property
            FontName = sByteArrayToString(tLogFont.lfFaceName())
           
            'tChooseFont.iPointSize As Long - store to FontSize property
            lFontSize = CLng(tChooseFont.iPointSize / 10)
       
        Case Else   'an error occured
            'call CommDlgExtendedError
            lExtendedError = CommDlgExtendedError   'store to ExtendedError property
       
    End Select
Exit Sub

ShowFontError:
    Exit Sub
End Sub

Public Sub ShowHelp()
    'run winhelp.exe with the specified help file
    Dim sHelpFileBuff As String
    Dim lData As Long
   
    On Error GoTo ShowHelpError
   
    '***    init Private properties
    iAction = 6  'Action property - ShowHelp
    lApiReturn = 0  'APIReturn property
    lExtendedError = 0  'ExtendedError property

    '***    prepare the buffers and parameters for the API function
    'sHelpFile is a null terminated string
    sHelpFileBuff = sHelpFile & Chr$(0)
   
    'sData is dependent on lHelpCommand
    Select Case lHelpCommand
        Case 0
            lData = 0
        Case Else
            lData = 0
    End Select
   
    '***    call the API function
    lApiReturn = WinHelp(lhdc, sHelpFile, lHelpCommand, lData)    ' - Store to APIReturn property
   
    Select Case lApiReturn
       
        Case 0  '
            'call CommDlgExtendedError
            lExtendedError = CommDlgExtendedError   ' - store to ExtendedError property
       
        Case Else   '
            'call CommDlgExtendedError
            lExtendedError = CommDlgExtendedError
       
    End Select
       
Exit Sub

ShowHelpError:
    Exit Sub
End Sub


Public Sub ShowOpen()
   
    'display the file open dialog box
    ShowFileDialog (1)  'Action property - ShowOpen
   
End Sub

Public Sub ShowPrinter()
    'display the print dialog
    Dim tPrintDlg As PrintDlg
   
    On Error GoTo ShowPrinterError
   
    '***    init public properties
    iAction = 5  'Action property - ShowPrint
    lApiReturn = 0  'APIReturn property
    lExtendedError = 0  'ExtendedError property

    '***    prepare tPrintDlg data
   
    'lStructSize As Long
    tPrintDlg.lStructSize = Len(tPrintDlg)
   
    'hwndOwner As Long
   
    'hDevMode As Long
   
    'hDevNames As Long
   
    'hdc As Long - init from hDC property
    tPrintDlg.hDc = lhdc
   
    'flags As Long - init from Flags property
    tPrintDlg.flags = lFlags
   
    'nFromPage As Integer - init from FromPage property
    tPrintDlg.nFromPage = lFromPage
   
    'nToPage As Integer - init from ToPage property
    tPrintDlg.nToPage = lToPage
   
    'nMinPage As Integer - init from Min property
    tPrintDlg.nMinPage = lMin
   
    'nMaxPage As Integer - init from Max property
    tPrintDlg.nMaxPage = lMax
   
    'nCopies As Integer - init from Copies property
    tPrintDlg.nCopies = lCopies
   
    'hInstance As Long
   
    'lCustData As Long
   
   
    '***    Call the PrintDlg API function
    lApiReturn = PrintDlg(tPrintDlg)
   
    '***    handle return from PrintDlg API function
    Select Case lApiReturn
       
        Case 0  'user canceled
            If bCancelError = True Then
                'generate an error
                Err.Raise (2001)
                Exit Sub
            End If
       
        Case 1  'user selected OK
            'nFromPage As Integer - store to FromPage property
            lFromPage = tPrintDlg.nFromPage
           
            'nToPage As Integer - store to ToPage property
            lToPage = tPrintDlg.nToPage
           
            'nMinPage As Integer - store to Min property
            lMin = tPrintDlg.nMinPage
           
            'nMaxPage As Integer - store to Max property
            lMax = tPrintDlg.nMaxPage
           
            'nCopies As Integer - store to Copies property
            lCopies = tPrintDlg.nCopies
   
        Case Else   'an error occured
            'call CommDlgExtendedError
            lExtendedError = CommDlgExtendedError   'store to ExtendedError property
   
    End Select

Exit Sub

ShowPrinterError:
   
    Exit Sub
   
End Sub


Public Sub ShowSave()
   
    'display the file save dialog box
    ShowFileDialog (2)  'Action property - ShowSave
   

End Sub


Public Property Get FileName() As String
    'return object's FileName property
    FileName = sFileName
End Property

Public Property Let FileName(vNewValue As String)
    'assign object's FileName property
    sFileName = vNewValue
End Property


Public Property Let Filter(vNewValue As String)
    'assign object's Filter property
    sFilter = vNewValue
End Property


Private Function sLeftOfNull(ByVal sIn As String)
    'returns the part of sIn preceding Chr$(0)
    Dim lNullPos As Long
   
    'init output
    sLeftOfNull = sIn
   
    'get position of first Chr$(0) in sIn
    lNullPos = InStr(sIn, Chr$(0))
   
    'return part of sIn to left of first Chr$(0) if found
    If lNullPos > 0 Then
        sLeftOfNull = Mid$(sIn, 1, lNullPos - 1)
    End If
   
End Function


Public Property Get Action() As Integer
    'Return object's Action property
    Action = iAction
End Property

Private Function sAPIFilter(sIn)
    'prepares sIn for use as a filter string in API common dialog functions
    Dim lChrNdx As Long
    Dim sOneChr As String
    Dim sOutStr As String
   
    'convert any | characters to nulls
    For lChrNdx = 1 To Len(sIn)
        sOneChr = Mid$(sIn, lChrNdx, 1)
        If sOneChr = "|" Then
            sOutStr = sOutStr & Chr$(0)
        Else
            sOutStr = sOutStr & sOneChr
        End If
    Next
   
    'add a null to the end
    sOutStr = sOutStr & Chr$(0)
   
    'return sOutStr
    sAPIFilter = sOutStr
   
End Function

Public Property Get FilterIndex() As Integer
    'return object's FilterIndex property
    FilterIndex = iFilterIndex
End Property

Public Property Let FilterIndex(vNewValue As Integer)
    iFilterIndex = vNewValue
End Property

Public Property Get CancelError() As Boolean
    'Return object's CancelError property
    CancelError = bCancelError
End Property

Public Property Let CancelError(vNewValue As Boolean)
    'Assign object's CancelError property
    bCancelError = vNewValue
End Property

Public Property Get Color() As Long
    'return object's Color property
    Color = lColor
End Property

Public Property Let Color(vNewValue As Long)
    'assign object's Color property
    lColor = vNewValue
End Property

Public Property Get Copies() As Long
    'return object's Copies property
    Copies = lCopies
End Property

Public Property Let Copies(vNewValue As Long)
    'assign object's Copies property
    lCopies = vNewValue
End Property

Public Property Get DefaultExt() As String
    'return object's DefaultExt property
    DefaultExt = sDefaultExt
End Property

Public Property Let DefaultExt(vNewValue As String)
    'assign object's DefaultExt property
    sDefaultExt = vNewValue
End Property

Public Property Get DialogTitle() As String
    'return object's FileName property
    DialogTitle = sDialogTitle
End Property

Public Property Let DialogTitle(vNewValue As String)
    'assign object's DialogTitle property
    sDialogTitle = vNewValue
End Property

Public Property Get flags() As Long
    'return object's Flags property
    flags = lFlags
End Property

Public Property Let flags(vNewValue As Long)
    'assign object's Flags property
    lFlags = vNewValue
End Property

Public Property Get FontBold() As Boolean
    'return object's FontBold property
    FontBold = bFontBold
End Property

Public Property Let FontBold(vNewValue As Boolean)
    'Assign object's FontBold property
    bFontBold = vNewValue
End Property

Public Property Get FontItalic() As Boolean
    'Return object's FontItalic property
    FontItalic = bFontItalic
End Property

Public Property Let FontItalic(vNewValue As Boolean)
    'Assign object's FontItalic property
    bFontItalic = vNewValue
End Property

Public Property Get FontName() As String
    'Return object's Fontname property
    FontName = sFontName
End Property

Public Property Let FontName(vNewValue As String)
    'Assign object's FontName property
    sFontName = vNewValue
End Property

Public Property Get FontSize() As Long
    'Return object's FontSize property
    FontSize = lFontSize
End Property

Public Property Let FontSize(vNewValue As Long)
    'Assign object's FontSize property
    lFontSize = vNewValue
End Property

Public Property Get FontStrikethru() As Boolean
    'Return object's FontStrikethru property
    FontStrikethru = bFontStrikethru
End Property

Public Property Let FontStrikethru(vNewValue As Boolean)
    'Assign object's - property
    bFontStrikethru = vNewValue
End Property

Public Property Get FontUnderline() As Boolean
    'Return object's FontUnderline property
    FontUnderline = bFontUnderline
End Property

Public Property Let FontUnderline(vNewValue As Boolean)
    'Assign object's FontUnderline property
    bFontUnderline = vNewValue
End Property

Public Property Get FromPage() As Long
    'Return object's FromPAge property
    FromPage = lFromPage
End Property

Public Property Let FromPage(vNewValue As Long)
    'Assign object's FromPage property
    lFromPage = vNewValue
End Property

Public Property Get hWndOwner() As Long
    'Return object's hWnd property
    hWndOwner = lhwndOwner
End Property

Public Property Let hWndOwner(vNewValue As Long)
    'Assign object's hWnd property
    lhwndOwner = vNewValue
End Property
Public Property Get hDc() As Long
    'Return object's hWnd property
    hDc = lhdc
End Property

Public Property Let hDc(vNewValue As Long)
    'Assign object's hWnd property
    lhdc = vNewValue
End Property

Public Property Get HelpCommand() As Long
    'Return object's HelpCommand property
    HelpCommand = lHelpCommand
End Property

Public Property Let HelpCommand(vNewValue As Long)
    'Assign object's HelpCommand property
    lHelpCommand = vNewValue
End Property

Public Property Get HelpContext() As String
    'Return object's HelpContext property
    HelpContext = sHelpContext
End Property

Public Property Let HelpContext(vNewValue As String)
    'Assign object's HelpContext property
    sHelpContext = vNewValue
End Property

Public Property Get HelpFile() As String
    'Return object's HelpFile property
    HelpFile = sHelpFile
End Property

Public Property Let HelpFile(vNewValue As String)
    'Assign object's HelpFile property
    sHelpFile = vNewValue
End Property

Public Property Get HelpKey() As String
    'Return object's HelpKey property
    HelpKey = sHelpKey
End Property

Public Property Let HelpKey(vNewValue As String)
    'Assign object's HelpKey property
    sHelpKey = vNewValue
End Property

Public Property Get InitDir() As String
    'Return object's InitDir property
    InitDir = sInitDir
End Property

Public Property Let InitDir(vNewValue As String)
    'Assign object's InitDir property
    sInitDir = vNewValue
End Property

Public Property Get Max() As Long
    'Return object's Max property
    Max = lMax
End Property

Public Property Let Max(vNewValue As Long)
    'Assign object's - property
    lMax = vNewValue
End Property

Public Property Get MaxFileSize() As Long
    'Return object's MaxFileSize property
    MaxFileSize = lMaxFileSize
End Property

Public Property Let MaxFileSize(vNewValue As Long)
    'Assign object's MaxFileSize property
    lMaxFileSize = vNewValue
End Property

Public Property Get Min() As Long
    'Return object's Min property
    Min = lMin
End Property

Public Property Let Min(vNewValue As Long)
    'Assign object's Min property
    lMin = vNewValue
End Property

Public Property Get Object() As Object
    'Return object's Object property
    Object = objObject
End Property

Public Property Let Object(vNewValue As Object)
    'Assign object's Object property
    objObject = vNewValue
End Property

Public Property Get PrinterDefault() As Integer
    'Return object's PrinterDefault property
    PrinterDefault = iPrinterDefault
End Property

Public Property Let PrinterDefault(vNewValue As Integer)
    'Assign object's PrinterDefault property
    iPrinterDefault = vNewValue
End Property

Public Property Get ToPage() As Long
    'Return object's ToPage property
    ToPage = lToPage
End Property

Public Property Let ToPage(vNewValue As Long)
    'Assign object's ToPage property
    lToPage = vNewValue
End Property

Public Property Get FileTitle() As String
    'return object's FileTitle property
    FileTitle = sFileTitle
End Property

Public Property Let FileTitle(vNewValue As String)
    'assign object's FileTitle property
    sFileTitle = vNewValue
End Property

Public Property Get APIReturn() As Long
    'return object's APIReturn property
    APIReturn = lApiReturn
End Property

Public Property Get ExtendedError() As Long
    'return object's ExtendedError property
    ExtendedError = lExtendedError
End Property


Private Function sByteArrayToString(abBytes() As Byte) As String
    'return a string from a byte array
    Dim lBytePoint As Long
    Dim lByteVal As Long
    Dim sOut As String
   
    'init array pointer
    lBytePoint = LBound(abBytes)
   
    'fill sOut with characters in array
    While lBytePoint <= UBound(abBytes)
       
        lByteVal = abBytes(lBytePoint)
       
        'return sOut and stop if Chr$(0) is encountered
        If lByteVal = 0 Then
            sByteArrayToString = sOut
            Exit Function
        Else
            sOut = sOut & Chr$(lByteVal)
        End If
       
        lBytePoint = lBytePoint + 1
   
    Wend
   
    'return sOut if Chr$(0) wasn't encountered
    sByteArrayToString = sOut
   
End Function
Private Sub ShowFileDialog(ByVal iAction As Integer)
   
    'display the file dialog for ShowOpen or ShowSave
   
    Dim tOpenFile As OpenFilename
    Dim lMaxSize As Long
    Dim sFileNameBuff As String
    Dim sFileTitleBuff As String
   
    On Error GoTo ShowFileDialogError
   
   
    '***    init property buffers
   
    iAction = iAction  'Action property
    lApiReturn = 0  'APIReturn property
    lExtendedError = 0  'ExtendedError property
       
   
    '***    prepare tOpenFile data
   
    'tOpenFile.lStructSize As Long
    tOpenFile.lStructSize = Len(tOpenFile)
   
    'tOpenFile.hWndOwner As Long - init from hdc property
    tOpenFile.hWndOwner = lhwndOwner
   
    'tOpenFile.lpstrFilter As String - init from Filter property
    tOpenFile.lpstrFilter = sAPIFilter(sFilter)
       
    'tOpenFile.iFilterIndex As Long - init from FilterIndex property
    tOpenFile.iFilterIndex = iFilterIndex
   
    'tOpenFile.lpstrFile As String
        'determine size of buffer from MaxFileSize property
        If lMaxFileSize > 0 Then
            lMaxSize = lMaxFileSize
        Else
            lMaxSize = 255
        End If
   
    'tOpenFile.lpstrFile As Long - init from FileName property
        'prepare sFileNameBuff
        sFileNameBuff = sFileName
        'pad with spaces
        While Len(sFileNameBuff) < lMaxSize - 1
            sFileNameBuff = sFileNameBuff & " "
        Wend
        'trim to length of lMaxFileSize - 1
        sFileNameBuff = Mid$(sFileNameBuff, 1, lMaxSize - 1)
        'null terminate
        sFileNameBuff = sFileNameBuff & Chr$(0)
    tOpenFile.lpstrFile = sFileNameBuff
   
    'nMaxFile As Long - init from MaxFileSize property
'    If lMaxFileSize <> 255 Then  'default is 255
        tOpenFile.nMaxFile = lMaxSize
'    End If
           
    'lpstrFileTitle As String - init from FileTitle property
        'prepare sFileTitleBuff
        sFileTitleBuff = sFileTitle
        'pad with spaces
        While Len(sFileTitleBuff) < lMaxSize - 1
            sFileTitleBuff = sFileTitleBuff & " "
        Wend
        'trim to length of lMaxFileSize - 1
        sFileTitleBuff = Mid$(sFileTitleBuff, 1, lMaxSize - 1)
        'null terminate
        sFileTitleBuff = sFileTitleBuff & Chr$(0)
    tOpenFile.lpstrFileTitle = sFileTitleBuff
       
    'tOpenFile.lpstrInitialDir As String - init from InitDir property
    tOpenFile.lpstrInitialDir = sInitDir
   
    'tOpenFile.lpstrTitle As String - init from DialogTitle property
    tOpenFile.lpstrTitle = sDialogTitle
   
    'tOpenFile.flags As Long - init from Flags property
    tOpenFile.flags = lFlags
       
    'tOpenFile.lpstrDefExt As String - init from DefaultExt property
    tOpenFile.lpstrDefExt = sDefaultExt
   
   
    '***    call the GetOpenFileName API function
    Select Case iAction
        Case 1  'ShowOpen
            lApiReturn = GetOpenFileName(tOpenFile)
        Case 2  'ShowSave
            lApiReturn = GetSaveFileName(tOpenFile)
        Case Else   'unknown action
            Exit Sub
    End Select
   
   
    '***    handle return from GetOpenFileName API function
    Select Case lApiReturn
       
        Case 0  'user canceled
        If bCancelError = True Then
            'generate an error
            Err.Raise (2001)
            Exit Sub
        End If
       
        Case 1  'user selected or entered a file
            'sFileName gets part of tOpenFile.lpstrFile to the left of first Chr$(0)
            sFileName = sLeftOfNull(tOpenFile.lpstrFile)
            sFileTitle = sLeftOfNull(tOpenFile.lpstrFileTitle)
       
        Case Else   'an error occured
            'call CommDlgExtendedError
            lExtendedError = CommDlgExtendedError
       
    End Select
   

Exit Sub

ShowFileDialogError:
   
    Exit Sub

End Sub



===================

Then add and call this function :

Function OpenFile() as string

Dim clCDl As New clsCommonDialog

clCDl.DialogTitle = "Select file to open"
clCDl.ShowOpen

OpenFile = clCDl.FileName


End Sub
0
 
LVL 12

Expert Comment

by:James Elliott
Comment Utility
I stand corrected.

0
 
LVL 44

Expert Comment

by:bruintje
Comment Utility
Hi Bravismore,

-add the common dialog activeX control to your form.
-give it a name like "ofdFile" needed to refer to in code
-in your form code to open the Common Dialog box you could use code similar to the following

dim strFile as string

'Show Open File Common Dialog Control
Me!ofdFile.DialogTitle = "TITLE"
Me!ofdFile.Filter = "Excel Files (*.xls)|*.xls"
' next line can be any default path like "C:\My Documents"
Me!ofdFile.InitDir = "C:\"
Me!ofdFile.ShowOpen
' to get the filename in a variable
strFile = Me!ofdFile.FileName

:O)Bruintje
0
 

Author Comment

by:bravismore
Comment Utility
Thanks for the prompt response

Will get back to u in a moment.
0
 

Author Comment

by:bravismore
Comment Utility
Hi cquinn

Dim clCDl As New clsCommonDialog
@compile time: It's complaining that a "Module is not a valid type"

Help pliz!
0
 

Author Comment

by:bravismore
Comment Utility
Hi cquinn

I am failing to rename the class module I created

Its just named automatically to class1
0
 

Author Comment

by:bravismore
Comment Utility
Sorry cquinn

It worked! Thanks!
0
 

Author Comment

by:bravismore
Comment Utility
Hi cquinn, jell

I have managed to use the dialog box
How can I tape the file handler so that instead of opening the file I use it as input to my own program


And also how can I use the same facility to save files.
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:bravismore
Comment Utility
How can I limit files which show up to only those with a specified extension(like *.ins).
0
 

Author Comment

by:bravismore
Comment Utility
how can I add a default file extension
0
 

Expert Comment

by:HobbitHouse
Comment Utility
Under Project >> Compontents, select "Microsoft Common Dialog Control 6.0 (SP3)" which will put a new tool on your toolbar, then put that tool onto your form and in the properties box, select "custom" and a window will open up that lets you set a file filter such as "*.ins".

You'll have to add code like (assumes you've named the common dialog "cdlgPath"):

cdlgPath.ShowOpen    ' opens the dialog box

filename = cdlgPath.FileName   ' gets the selected file name

I don't know that this will do everything that all of the code provided by cquinn will do, but it sure is a lot simpler.
0
 
LVL 44

Expert Comment

by:bruintje
Comment Utility
that's essentially what i already added here but gt no reaction on that

:O)Bruintje
0
 

Author Comment

by:bravismore
Comment Utility
Thanks

Will get back to u asap!
0
 

Expert Comment

by:HobbitHouse
Comment Utility
Bruintje --- yep, I missed your comment; got swamped by the length of the thread

bravismore --- you've got two of us now telling you exactly the same thing; probably be a good idea to check it out.
0
 
LVL 1

Expert Comment

by:Moondancer
Comment Utility
Greetings,

This question is current, others below are not.  ADMINISTRATION WILL BE CONTACTING YOU SHORTLY.  Moderators Computer101 or Netminder will return to finalize these if they are still open in 14 days.  Experts, please post closing recommendations before that time.

Below are your open questions as of today.  Questions which have been inactive for 21 days or longer are considered to be abandoned and for those, your options are:
1. Accept a Comment As Answer (use the button next to the Expert's name).
2. Close the question if the information was not useful to you, but may help others. You must tell the participants why you wish to do this, and allow for Expert response.  This choice will include a refund to you, and will move this question to our PAQ (Previously Asked Question) database.  If you found information outside this question thread, please add it.
3. Ask Community Support to help split points between participating experts, or just comment here with details and we'll respond with the process.
4. Delete the question (if it has no potential value for others).
   --> Post comments for expert of your intention to delete and why
   --> YOU CANNOT DELETE A QUESTION with comments; special handling by a Moderator is required.

For special handling needs, please post a zero point question in the link below and include the URL (question QID/link) that it regards with details.
http://www.experts-exchange.com/jsp/qList.jsp?ta=commspt
 
Please click this link for Help Desk, Guidelines/Member Agreement and the Question/Answer process.  http://www.experts-exchange.com/jsp/cmtyHelpDesk.jsp

Click you Member Profile to view your question history and please keep them updated. If you are a KnowledgePro user, use the Power Search option to find them.  

Questions which are LOCKED with a Proposed Answer but do not help you, should be rejected with comments added.  When you grade the question less than an A, please comment as to why.  This helps all involved, as well as others who may access this item in the future.  PLEASE DO NOT AWARD POINTS TO ME.

To view your open questions, please click the following link(s) and keep them all current with updates.
http://www.experts-exchange.com/questions/Q.20286990.html
http://www.experts-exchange.com/questions/Q.20286911.html
http://www.experts-exchange.com/questions/Q.20289019.html
http://www.experts-exchange.com/questions/Q.20290115.html
http://www.experts-exchange.com/questions/Q.20291339.html



*****  E X P E R T S    P L E A S E  ******  Leave your closing recommendations.
If you are interested in the cleanup effort, please click this link
http://www.experts-exchange.com/jsp/qManageQuestion.jsp?ta=commspt&qid=20274643
POINTS FOR EXPERTS awaiting comments are listed in the link below
http://www.experts-exchange.com/commspt/Q.20277028.html
 
Moderators will finalize this question if in @14 days Asker has not responded.  This will be moved to the PAQ (Previously Asked Questions) at zero points, deleted or awarded.
 
Thanks everyone.
Moondancer
Moderator @ Experts Exchange
0
 
LVL 44

Expert Comment

by:bruintje
Comment Utility
Hi Moondancer, IF the asker doesn't respond

Q. was if and how to use the file open dialog
A. is the long post from cquinn

bravismore to cquinn > It worked! Thanks!

So i would simply say PAQ and points to cquinn

:O)Bruintje
0
 
LVL 1

Expert Comment

by:Moondancer
Comment Utility
Thank you very much.

Finalized today.

Moondancer - EE Moderator
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Most if not all databases provide tools to filter data; even simple mail-merge programs might offer basic filtering capabilities. This is so important that, although Access has many built-in features to help the user in this task, developers often n…
In Debugging – Part 1, you learned the basics of the debugging process. You learned how to avoid bugs, as well as how to utilize the Immediate window in the debugging process. This article takes things to the next level by showing you how you can us…
Using Microsoft Access, learn some simple rules for how to construct tables in a relational database. Split up all multi-value fields into single values: Split up fields that belong to other things into separate tables: Make sure that all record…
In Microsoft Access, learn how to use Dlookup and other domain aggregate functions and one method of specifying a string value within a string. Specify the first argument, which is the expression to be returned: Specify the second argument, which …

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

7 Experts available now in Live!

Get 1:1 Help Now