FileDialog InitialView Property doesn't work !

Jaafar Tribak

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
9,596
Office Version
  1. 2016
Platform
  1. Windows
Hi dear forum members,

Code: 
Sub Test()

    Dim oDlg As FileDialog
    
    Set oDlg = Application.FileDialog(msoFileDialogOpen)
    With oDlg
        .Title = "Select a file"
        .InitialFileName = "C:\MyPictures"
        .AllowMultiSelect = False
[COLOR=#ff0000][B]        .InitialView = msoFileDialogViewLargeIcons[/B][/COLOR]
        If .Show = -1 Then
            MsgBox "You selected: " & .SelectedItems(1)
        End If
    End With

End Sub

As you can see in the above code, I set the InitialView to LargeIcons but for some reason it doesn't take effect.. same goes when I try other views like Icon,Thumbnail,List etc ..

I have done a quick search on the net but it seems that this is a bug .

Does anybody know if there is a fix for this ?

Regards.
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Sort by date Sort by votes
Well apparently this is a bug and there is no known way to fix it.

But after some further research, I stumbled upon this nifty MFC article on this page which gave me the idea to use Spy++ and see if I could do the same with vba ... After some trial and error experimentation, I seem to have managed to come up with a "solution" to this problem.

Basically, for the sake of easy use, I have defined a custom Property (InitialViewAPI) that takes a value from a Public Enum (InitialView) which imitates the native excel FileDiaolg InitialView Property .

So for example, before calling the Show Method of the FileDialogOpen, instead of setting its native initialView Property the usual way like this :
Code: 
 [B]Application.FileDialog(msoFileDialogOpen).InitialView = msoFileDialogViewLargeIcons[/B]

You now set it like this :
Code: 
 [B]InitialViewAPI = VISTA_LARGE_ICONS[/B]

see TEST macro further down.


workbook demo



1- API code in a Standard Module:
Code: 
Option Explicit

Public Enum InitialView
    XP_DO_NOT_PERSIST = (-1)
    XP_UNDEFINED = 0
    XP_ICONS = &H7029
    XP_LIST = &H702B
    XP_DETAILS = &H702C
    XP_THUMBNAILS = &H702D
    XP_TILES = &H702E
    
    VISTA_DO_NOT_PERSIST = (-1)
    VISTA_UNDEFINED = 0
    VISTA_DETAILS = &H704B
    VISTA_TILES = &H704C
    VISTA_EXTRA_LARGE_ICONS = &H704D
    VISTA_MEDIUM_ICONS = &H704E
    VISTA_LARGE_ICONS = &H704F
    VISTA_SMALL_ICONS = &H7050
    VISTA_LIST = &H7051
End Enum

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  Win64 Then
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As Long
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Private Declare PtrSafe Function EnumChildWindows Lib "user32" (ByVal hWndParent As LongPtr, ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal hData As LongPtr) As Long
    Private Declare PtrSafe Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Private Declare PtrSafe Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    
    Private hCBTHook As LongPtr, lDlgPrevProc As LongPtr

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 

    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As Long) As Long
    Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
    Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    
    Private hCBTHook As Long, lDlgPrevProc As Long

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private Const WH_CBT = &H5
Private Const HCBT_CREATEWND = &H3
Private Const GWL_WNDPROC = -4
Private Const WM_USER = &H400
Private Const WM_COMMAND = &H111
Private Const WM_DESTROY = &H2


Public Property Let InitialViewAPI(ByVal VIEW As InitialView)
    hCBTHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, GetModuleHandle(vbNullString), GetCurrentThreadId)
    SetProp Application.hwnd, "VIEW", VIEW
End Property


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Function CBTProc(ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Function CBTProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

    Dim sClassName As String * 256, lRet As Long
    
    If nCode = HCBT_CREATEWND Then
        lRet = GetClassName(wParam, sClassName, 256)
        If Left(sClassName, lRet) = "#32770" Then
            UnhookWindowsHookEx hCBTHook
            lDlgPrevProc = SetWindowLong(wParam, GWL_WNDPROC, AddressOf lDlgProc)
        End If
    End If
    Call CallNextHookEx(hCBTHook, nCode, wParam, lParam)
 
End Function



[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Function lDlgProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Function lDlgProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

    Dim sBuffer As String * 256, lRet As Long
    
    Select Case uMsg
        Case WM_COMMAND, WM_USER
            Call EnumChildWindows(hwnd, AddressOf EnumChildProc, 0)
            Call PostMessage(GetProp(Application.hwnd, "hwnd"), WM_COMMAND, GetProp(Application.hwnd, "VIEW"), 0)
        Case WM_DESTROY
            Call SetWindowLong(hwnd, GWL_WNDPROC, lDlgPrevProc)
            Call RemoveProp(Application.hwnd, "hwnd")
            Call RemoveProp(Application.hwnd, "VIEW")
    End Select
    lDlgProc = CallWindowProc(lDlgPrevProc, hwnd, uMsg, wParam, lParam)
    
End Function


[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Function EnumChildProc(ByVal hwnd As LongPtr, ByVal lParam As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

    Dim sBuffer As String * 256, lRet As Long
    
    lRet = GetClassName(hwnd, sBuffer, 256)
    If Left(sBuffer, lRet) = "SHELLDLL_DefView" Then
        Call SetProp(Application.hwnd, "hwnd", hwnd)
        EnumChildProc = 0
    Else
        EnumChildProc = 1
    End If
End Function



2- Code Usage:
Code: 
Option Explicit

Sub Test()

    Dim oDlg As FileDialog
    
    Set oDlg = Application.FileDialog(msoFileDialogOpen)
    
    With oDlg
        .Title = "API InitialView Demo -- Select a file"
        .InitialFileName = "C:\"
        .AllowMultiSelect = False
        
[B][COLOR=#008000]        'Set the dialog view via API calls[/COLOR][/B]
        [B][COLOR=#ff0000]InitialViewAPI = VISTA_LARGE_ICONS[/COLOR][/B] [B][COLOR=#008000]'<==(equivalent to msoFileDialogViewLargeIcons)[/COLOR][/B]
        
        If .Show = -1 Then
            MsgBox "You selected: " & .SelectedItems(1)
        End If
    End With


End Sub
 
Upvote 0
Found your post when testing the FileDialog.InitialView property and found it wasn't working as expected. Nicely done.
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Folder picker - list what was chosen?
Replies
3
Views
226
TheWennerWoman
T
H
  • Question
Macro to limit browsing to specific File
Replies
2
Views
228
howard
H
J
  • Solved
FileDialog to only show xlsx files containing certain text
Replies
3
Views
471
Fluff
Fluff
G
  • Solved
Change Macro to import files from hyperlinks
2
Replies
12
Views
394
GarnesGambit
G
H
  • Solved
Mscro not Displaying CVS Files in Directory
Replies
3
Views
343
Joe4
Joe4

Forum statistics

Threads
1,214,606
Messages
6,120,487
Members
448,967
Latest member
visheshkotha

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top