Explorer Style of the Dialog generated with the GetOpenFileName Windows API

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
                        "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
         
Private Declare Function GetVersionEx Lib "kernel32" _
                        Alias "GetVersionExA" (lpVersionInformation As Any) As Long

Private Declare Function FindWindowEx Lib "user32" Alias _
            "FindWindowExA" (ByVal hWndParent As Long, _
                            ByVal hWndChildAfter As Long, _
                            ByVal lpClassName As String, _
                            ByVal lpWindowName As String) As Long

Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function SendMessage Lib "user32" _
                         Alias "SendMessageA" _
                        (ByVal hwnd As Long, _
                         ByVal wMsg As Long, _
                         ByVal wParam As Long, _
                         lParam As Any) As Long

'var for exposed property
Private m_lvInitialView As Long


'windows messages & notifications etc
Private Const WM_COMMAND = &H111
Private Const WM_NOTIFY As Long = &H4E&
Private Const WM_INITDIALOG As Long = &H110
Private Const CDN_FIRST As Long = -601
Private Const CDN_INITDONE As Long = (CDN_FIRST - &H0&)
Private Const MAX_PATH As Long = 260

'openfilename constants
Private Const OFN_ENABLESIZING As Long = &H800000
Private Const OFN_EX_NOPLACESBAR As Long = &H1


Private Const OFN_ALLOWMULTISELECT As Long = &H200
Private Const OFN_CREATEPROMPT As Long = &H2000
Private Const OFN_ENABLEHOOK As Long = &H20
Private Const OFN_ENABLETEMPLATE As Long = &H40
Private Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
Private Const OFN_EXPLORER As Long = &H80000
Private Const OFN_EXTENSIONDIFFERENT As Long = &H400
Private Const OFN_FILEMUSTEXIST As Long = &H1000
Private Const OFN_HIDEREADONLY As Long = &H4
Private Const OFN_LONGNAMES As Long = &H200000
Private Const OFN_NOCHANGEDIR As Long = &H8
Private Const OFN_NODEREFERENCELINKS As Long = &H100000
Private Const OFN_NOLONGNAMES As Long = &H40000
Private Const OFN_NONETWORKBUTTON As Long = &H20000
Private Const OFN_NOREADONLYRETURN As Long = &H8000& 'see comments
Private Const OFN_NOTESTFILECREATE As Long = &H10000
Private Const OFN_NOVALIDATE As Long = &H100
Private Const OFN_OVERWRITEPROMPT As Long = &H2
Private Const OFN_PATHMUSTEXIST As Long = &H800
Private Const OFN_READONLY As Long = &H1
Private Const OFN_SHAREAWARE As Long = &H4000
Private Const OFN_SHAREFALLTHROUGH As Long = 2
Private Const OFN_SHAREWARN As Long = 0
Private Const OFN_SHARENOWARN As Long = 1
Private Const OFN_SHOWHELP As Long = &H10
Private Const OFS_MAXPATHNAME As Long = 260


Private Const SHVIEW_ICON As Long = &H7029
Private Const SHVIEW_LIST As Long = &H702B
Private Const SHVIEW_REPORT As Long = &H702C
Private Const SHVIEW_THUMBNAIL As Long = &H702D
Private Const SHVIEW_TILE As Long = &H702E

Private Const OSVEX_LENGTH As Long = 88

Private Type OPENFILENAME
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex 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
  'fnHook As Long
  lpTemplateName As String
End Type

Private Property Let OFN_SetInitialView(ByVal initview As Long)

   m_lvInitialView = initview


End Property

Private Function OFNHookProc(ByVal hwnd As Long, _
                            ByVal uMsg As Long, _
                            ByVal wParam As Long, _
                            ByVal lParam As Long) As Long

   Dim hWndParent As Long
   Dim hwndLv As Long
   Static bLvSetupDone As Boolean

   Select Case uMsg
      Case WM_INITDIALOG
        'Initdialog is set when the dialog
        'has been created and is ready to
        'be displayed, so set our flag
        'to prevent re-executing the code
        'in the wm_notify message. This is
        'required as the dialog receives a
        'number of WM_NOTIFY messages throughout
        'the life of the dialog. If this is not
        'done, and the user chooses a different
        'view, on the next WM_NOTIFY message
        'the listview would be reset to the
        'initial view, probably ticking off
        'the user. The variable is declared
        'static to preserve values between
        'calls; it will be automatically reset
        'on subsequent showing of the dialog.
         bLvSetupDone = False

        'other WM_INITDIALOG code here, such
        'as caption or button changing, or
        'centering the dialog.

      Case WM_NOTIFY

            If bLvSetupDone = False Then

             'hwnd is the handle to the dialog
             'hwndParent is the handle to the common control
             'hwndLv is the handle to the listview itself
               hWndParent = GetParent(hwnd)
               hwndLv = FindWindowEx(hWndParent, 0, "SHELLDLL_DefView", vbNullChar)

               If hwndLv > 0 Then
                  Call SendMessage(hwndLv, WM_COMMAND, ByVal m_lvInitialView, ByVal 0&)

                 'since we found the lv hwnd, assume the
                 'command was received and set the flag
                 'to prevent recalling this routine
                  bLvSetupDone = True
               End If  'hwndLv

            End If  'bLvSetupDone

         Case Else

   End Select

End Function

Public Function dabFileChooser(ByVal dbTitle As String, ByVal dbFilter As String, _
                                ByVal dbViewType As String, ByVal dbStartPath As String, _
                                ByVal dbMultiSelect As Boolean, ByRef obj_dbObject As DBDialog) As Boolean
On Error GoTo Err_dabFileChooser


Dim aFiles() As String
Dim aTemp() As String
Dim tempPath As String
Dim tempFileName As String

Dim dbflags As String
Dim buff As String

If dbMultiSelect Then
     dbflags = OFN_HIDEREADONLY Or OFN_EXPLORER Or OFN_ENABLESIZING Or OFN_ENABLEHOOK Or OFN_ALLOWMULTISELECT
Else
    dbflags = OFN_HIDEREADONLY Or OFN_EXPLORER Or OFN_ENABLESIZING Or OFN_ENABLEHOOK
End If



Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim sFilter As String


OFN_SetInitialView = dbViewType



'OpenFile.lStructSize = Len(OpenFile)
OpenFile.lStructSize = OSVEX_LENGTH
OpenFile.hwndOwner = ACCESS.hWndAccessApp
OpenFile.hInstance = ACCESS.hWndAccessApp
'sFilter = "Excel Files" & vbNullChar & "*.xls;*.xlsx" & vbNullChar & _
          "All Files" & vbNullChar & "*.*" & vbNullChar & vbNullChar

sFilter = dbFilter

OpenFile.lpstrFilter = sFilter
OpenFile.nFilterIndex = 1
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = dbStartPath
OpenFile.lpstrTitle = dbTitle
OpenFile.flags = dbflags
OpenFile.lpfnHook = FARPROC(AddressOf OFNHookProc)

'flagsEx = OFN_EX_NOPLACESBAR OFN_EXPLORER

lReturn = GetOpenFileName(OpenFile)

'there is someting there
If lReturn <> 0 Then

    dabFileChooser = True

    If dbMultiSelect Then
        'trim all the nulls from the end
        buff = TrimNull(OpenFile.lpstrFile)
        
        'split all values and add to the class  not being used now.
        'aTemp = Split(buff, Chr$(0))
        'obj_dbObject.FileNames = aTemp
        
        tempPath = StripDelimitedItem(buff, vbNullChar)
        obj_dbObject.MainPath = tempPath
        
        Do While Len(buff) > 3
        
            tempFileName = StripDelimitedItem(buff, vbNullChar)
            
            Call obj_dbObject.FileNamesAdd(tempFileName)
            Call obj_dbObject.FullFilePathsAdd(tempPath & tempFileName)
            
        Loop

        
        
    Else
    
        dabFileChooser = True
        obj_dbObject.FullFilePath = Trim(OpenFile.lpstrFile)
    
    End If

Else

    dabFileChooser = False

End If


Exit_dabFileChooser:
    Exit Function

Err_dabFileChooser:
    MsgBox Err.Number & " " & Err.Description & " dabFileChooser", vbCritical, "LuTTool Error"
    Resume Exit_dabFileChooser
End Function

Public Function FARPROC(pfn As Long) As Long

  'A dummy procedure that receives and returns
  'the return value of the AddressOf operator.

  'Obtain and set the address of the callback
  'This workaround is needed as you can't assign
  'AddressOf directly to a member of a user-
  'defined type, but you can assign it to another
  'long and use that (as returned here)

  FARPROC = pfn

End Function

Select allOpen in new window