Solved

MS Access VBA Open Explorer.exe window to thumbnails/extra large icons view

Posted on 2011-03-10
13
2,056 Views
Last Modified: 2012-08-13
I have a button on an MS Access 2003 form that opens a Windows Explorer window at a specified folder location.
The code works perfectly.
The folder contains JPG images.
The window opens in Details view.

I want it to open, or be changed to, thumbnails view in XP or Extra Large Icons in Windows 7
I have some familiarity with Windows API coding -- not a lot -- and not enough to figure out how to do this.

As this is a database application run on 13 units, with 10's of thousands of folders, no suggestions of going into Folder Options | View will be entertained.  It must be coded.  I have looked at Bags and BagsMRU in the registry and can't figure out how to make that work.

Any suggestions will be welcome.

Thanks,

Nick67
Private Sub cmdOpenFolder_Click()
Dim db As Database
Dim rs As Recordset
Dim WindowState As Integer
Dim mypath As String


Set db = CurrentDb
Set rs = db.OpenRecordset("select distinct Path from tblPictures where [JobID]=" & Me.JobID & ";", dbOpenDynaset, dbSeeChanges)
'Bail on an empty recordset
If (rs.EOF And rs.BOF) = False Then
    rs.MoveFirst
    If rs.RecordCount > 1 Then
        WindowState = vbNormalNoFocus
    Else
        WindowState = vbMaximizedFocus
    End If
    Do While rs.EOF = False
        Shell "explorer.exe " & Chr(34) & rs!Path & Chr(34), WindowState
        mypath = rs!Path
        rs.MoveNext
        
    Loop
End If

End Sub

Open in new window

0
Comment
Question by:Nick67
  • 8
  • 4
13 Comments
 
LVL 119

Assisted Solution

by:Rey Obrero
Rey Obrero earned 100 total points
ID: 35100190
try this

    Do While rs.EOF = False
        Shell "explorer.exe " & Chr(34) & rs!Path & Chr(34), WindowState
       
         doevents
         sendkeys "%vh",true
0
 
LVL 84

Assisted Solution

by:Scott McDaniel (Microsoft Access MVP - EE MVE )
Scott McDaniel (Microsoft Access MVP - EE MVE ) earned 150 total points
ID: 35100215
See this question:

http://www.experts-exchange.com/Microsoft/Development/Q_22637802.html

It uses API calls to manage this, which would work across all your machines. I believe you'll have to figure out exactly which of the Expert comments from that question to use in order to get a final solution.

You can also build a Form that uses a WebBrowser control which can be set to show an explorer-like interface, but I'm not sure that will do what you want.
0
 
LVL 26

Author Comment

by:Nick67
ID: 35100237
SendKeys and Windows 7 are an evil mix.
I had to get rid of all the SendKeys code I had when Win7 came into the environment because the NumLock bug reared it's head.

SendKeys would work, in theory, but I can't use it.
0
 
LVL 26

Author Comment

by:Nick67
ID: 35100346
I don't do a lot of Windows API stuff -- but I dabble in it when needful -- which in this case it is
I can get the handle, and set the window to the foreground.

Now, how do I PostMessage or SendMessage...

Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long

... that I want thumbnails or extra large icons.
Thumbnails is related to &H702D& or 28717
Extra Large Icons ... don't know

Dim hWnd As Long
'all right, give 'er
'FnFindWindowLike(Something as String)is an API call that returns a windows handle
'to a window whose caption contains the string passed in, or it returns 0 if it fails

mypath = Left(mypath, Len(mypath) - 1)

MsgBox mypath
hWnd = FnFindWindowLike(mypath)
MsgBox hWnd

'similarly FnSetForegroundWindow (Something as String) is an API call that
'Brings a window whose caption contains the string passed in to the foreground
FnSetForegroundWindow (mypath)

Open in new window

0
 
LVL 26

Author Comment

by:Nick67
ID: 35100667
@LSMConsulting

The code for that question looks good -- but it just opens two windows instead of one for me.
And changes neither of them from details no matter which of the possible constants I send in.

It also takes quite some time to time out before giving up on chnaging either window.  
0
 
LVL 26

Author Comment

by:Nick67
ID: 35100806
And I am definitely getting the right window when I look for its handle because if I call it via...

Shell "explorer.exe " & Chr(34) & rs!Path & Chr(34), vbNormalNoFocus

...so I can move it around...

Declare Function MoveWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Dim retval
retval = MoveWindow(hWnd, 200, 0, 800, 600, 1)

...it moves.  So there is something I am not getting!
0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 84
ID: 35100859
Can you post the full code you're using?
0
 
LVL 26

Accepted Solution

by:
Nick67 earned 0 total points
ID: 35101038
Here it all is.
There are a lot more API functions in there that are in use for this problem.
I left them all in, in case there were dependencies--and because I don't thouroughly understand the way they might interact
'In a module
'Lots of these don't apply to the present problem but I'll post for completeness

Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function CloseWindow Lib "user32" (ByVal hWnd As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Declare Function GetActiveWindow Lib "user32" () As Long
Declare Function MoveWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Declare Sub mouse_event Lib "user32" (ByVal dwflags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cbuttons As Long, ByVal dwExtraInfo As Long)
Declare Function DeviceCapabilities Lib "winspool.drv" Alias "DeviceCapabilitiesA" (ByVal lpDeviceName As String, ByVal lpPort As String, ByVal iIndex As Long, ByVal lpOutput As String, lpDevMode As Any) As Long


Private psAppNameContains As String
Private pbFound As Boolean
Private sTitle As String
Public Const WM_CLOSE = &H10
Public Const WM_CHAR = &H102
Public Const VK_RETURN = &HD
Public Const WM_KEYDOWN = &H100
Public Const DC_DUPLEX = 7
Public Const DC_BINS = 6
Public Const DC_BINNAMES = 12
Private Const viewDEFAULT = 0
Private Const viewICON = &H7029
Private Const viewLIST = &H702B
Private Const viewREPORT = &H702C
Private Const viewTHUMBNAIL = &H702D
Private Const viewTILE = &H702E
Private Const WM_COMMAND = &H111

Private Type FindWindowParameters

    strTitle As String  'INPUT
    hWnd As Long        'OUTPUT

End Type


Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Boolean

Dim sSave As String, Ret As Long
Dim a As Long

Ret = GetWindowTextLength(hWnd)
sSave = Space(Ret)
GetWindowText hWnd, sSave, Ret + 1
If InStr(1, sSave, myWindowText) <> 0 Then
myHwnd = hWnd
End If
'continue enumeration
EnumWindowsProc = True

End Function

Public Function FnFindWindowLike(strWindowTitle As String) As Long

    'We'll pass a custom structure in as the parameter to store our result...
    Dim Parameters As FindWindowParameters
    Parameters.strTitle = strWindowTitle ' Input parameter

    Call EnumWindows(AddressOf EnumWindowProc, VarPtr(Parameters))
    
    FnFindWindowLike = Parameters.hWnd
    
End Function

Private Function EnumWindowProc(ByVal hWnd As Long, _
                               lParam As FindWindowParameters) As Long
   
   Dim strWindowTitle As String

   strWindowTitle = Space(260)
   Call GetWindowText(hWnd, strWindowTitle, 260)
   strWindowTitle = TrimNull(strWindowTitle) ' Remove extra null terminator
                                          
   If strWindowTitle Like lParam.strTitle Then
   
        lParam.hWnd = hWnd 'Store the result for later.
        EnumWindowProc = 0 'This will stop enumerating more windows
   
   End If
                           
   EnumWindowProc = 1

End Function

Private Function TrimNull(strNullTerminatedString As String)

    Dim lngPos As Long

    'Remove unnecessary null terminator
    lngPos = InStr(strNullTerminatedString, Chr$(0))
   
    If lngPos Then
        TrimNull = Left$(strNullTerminatedString, lngPos - 1)
    Else
        TrimNull = strNullTerminatedString
    End If
   
End Function

Function ChangeView(hWnd As Long) As Integer

PostMessage hWnd, WM_COMMAND, ByVal &H704D, 0&
ChangeView = 1
End Function


'--------------------------------------------------------------

'in the form's module

Private Sub cmdOpenFolder_Click()
Dim db As Database
Dim rs As Recordset
Dim WindowState As Integer
Dim mypath As String
Dim myreturn


Set db = CurrentDb
Set rs = db.OpenRecordset("select distinct Path from tblPictures where [JobID]=" & Me.JobID & ";", dbOpenDynaset, dbSeeChanges)
'Bail on an empty recordset
If (rs.EOF And rs.BOF) = False Then
    rs.MoveFirst
    If rs.RecordCount > 1 Then
        WindowState = vbNormalNoFocus
    Else
        WindowState = vbMaximizedFocus
    End If
    
    
    
    
    Do While rs.EOF = False
        Shell "explorer.exe " & Chr(34) & rs!Path & Chr(34), WindowState
        mypath = rs!Path
        rs.MoveNext
    Loop
End If

mypath = Left(mypath, Len(mypath) - 1)

'Dim wait As Double
'wait = Timer
'While Timer < wait + 3
'   DoEvents  'do nothing
'Wend


Dim hWnd As Long
'all right, give 'er
'FnFindWindowLike(Something as String)is an API call that returns a windows handle
'to a window whose caption contains the string passed in, or it returns 0 if it fails

'MsgBox mypath
hWnd = FnFindWindowLike(mypath)
'MsgBox hWnd

'similarly FnSetForegroundWindow (Something as String) is an API call that
'Brings a window whose caption contains the string passed in to the foreground
FnSetForegroundWindow (mypath)
'Dim retval
'retval = MoveWindow(hWnd, 200, 0, 800, 600, 1)

'********** this next line just doesn't work*******************
'********** no errors, but no results either*******************
myreturn = ChangeView(hWnd)

rs.Close

end sub

Open in new window

0
 
LVL 26

Assisted Solution

by:Nick67
Nick67 earned 0 total points
ID: 35111976
Ok

I got it.  I was getting the handle to the explorer window, and it wasn't playing.  I figured that there must be child windows then.  There are an uncountable pile of child windows--one of which is the one that the PostMessage needs to get sent to.  I adapted the code at
http://support.microsoft.com/kb/183009
to first enumerate all those child windows,and then after discovering that the window with the class ShellTabWindowClass was the critical one, setting up the code to send it the right message.

Now, can anyone help with elegance, removing redundancy, and helping me understand the code?
I dabble with API code, but I don't understand it--and that always leaves me uneasy.
' I took all the module code from http://support.microsoft.com/kb/183009 and put it in a regular module
' Some of it overlapped with other API code I had in place.
' below I am only going to post the Function that I altered
'____________________________________________________

Function EnumChildProc(ByVal lhWnd As Long, ByVal lParam As Long) As Long
Dim RetVal As Long
Dim WinClassBuf As String * 255, WinTitleBuf As String * 255
Dim WinClass As String, WinTitle As String
Dim WinRect As RECT
Dim WinWidth As Long, WinHeight As Long

RetVal = GetClassName(lhWnd, WinClassBuf, 255)
WinClass = StripNulls(WinClassBuf)  ' remove extra Nulls & spaces
RetVal = GetWindowText(lhWnd, WinTitleBuf, 255)
WinTitle = StripNulls(WinTitleBuf)
ChildCount = ChildCount + 1
' see the Windows Class and Title for each Child Window enumerated
'Debug.Print "   Child Class = "; WinClass; ", Title = "; WinTitle
' You can find any type of Window by searching for its WinClass

'This is my alteration
'I am passing in the hWnd from the explorer window, not anything else
'the "ShellTabWindowClass" child window is the one that needs to get the message
If WinClass = "ShellTabWindowClass" Then
    Call ChangeView(lhWnd)
    Exit Function
End If
'end alterations

If WinClass = "ThunderTextBox" Then    ' TextBox Window
   RetVal = GetWindowRect(lhWnd, WinRect)  ' get current size
   WinWidth = WinRect.Right - WinRect.Left ' keep current width
   WinHeight = (WinRect.Bottom - WinRect.Top) * 2 ' double height
   RetVal = MoveWindow(lhWnd, 0, 0, WinWidth, WinHeight, True)
   EnumChildProc = False
Else
   EnumChildProc = True
End If
End Function

Open in new window

'in another module, this code exists.
'it could be combined with the first snippet I suppose
Public Const Extra_Large_Icons = &H704D
Public Const Large_Icons = &H704F
Public Const Medium_Icons = &H704E
Public Const Small_Icons = &H7050
Public Const List = &H7051
Public Const Details = &H704B
Public Const Tiles = &H704C
'these are the Windows 7 constants

Public Const viewDEFAULT = 0
Public Const viewICON = &H7029
Public Const viewLIST = &H702B
Public Const viewREPORT = &H702C
Public Const viewTHUMBNAIL = &H702D
Public Const viewTILE = &H702E
'these are XP Constants

Public Const WM_COMMAND = &H111

'--------------------------------------------------

'this function sends the change view to ExtraLargeIcons to the window with the handle passed in
Function ChangeView(hwnd As Long) As Integer
PostMessage hwnd, WM_COMMAND, ByVal Extra_Large_Icons, 0&
ChangeView = 1
End Function

Open in new window

'this is the code from the button click that get's er done

Private Sub cmdOpenFolder_Click()
Dim db As Database
Dim rs As Recordset
Dim WindowState As Integer
Dim MyPath As String
Dim myreturn


Set db = CurrentDb
Set rs = db.OpenRecordset("select distinct Path from tblPictures where [JobID]=" & Me.JobID & ";", dbOpenDynaset, dbSeeChanges)
'Bail on an empty recordset
If (rs.EOF And rs.BOF) = False Then
    rs.MoveFirst
    If rs.RecordCount > 1 Then
        WindowState = vbNormalNoFocus
    Else
        WindowState = vbMaximizedFocus
    End If
    
    
    
    
    Do While rs.EOF = False
        Shell "explorer.exe " & Chr(34) & rs!Path & Chr(34), WindowState
        MyPath = rs!Path
        rs.MoveNext
    Loop
End If

MyPath = Left(MyPath, Len(MyPath) - 1)

'you have to pause up a bit or the window opened above won't be initialized enough to find a handle
Dim wait As Double
wait = Timer
While Timer < wait + 1
   DoEvents  'do nothing
Wend


Dim hwnd As Long
'all right, give 'er
'FnFindWindowLike(Something as String)is an API call that returns a windows handle
'to a window whose caption contains the string passed in, or it returns 0 if it fails

'MsgBox mypath
hwnd = FnFindWindowLike(MyPath)
'MsgBox hWnd

'similarly FnSetForegroundWindow (Something as String) is an API call that
'Brings a window whose caption contains the string passed in to the foreground
FnSetForegroundWindow (MyPath)

'this code is adapted from the Command1_Click code at http://support.microsoft.com/kb/183009
'instead of passing in the handles that the code originally did, I set it to pass in the 
'handle of the explorer window as discovered above.
Dim lRet As Long, lParam As Long
Dim lhWnd As Long

'lhWnd = Me.hwnd  ' Find the Form's Child Windows
' Comment the line above and uncomment the line below to
' enumerate Windows for the DeskTop rather than for the Form
'lhWnd = GetDesktopWindow()  ' Find the Desktop's Child Windows
lhWnd = hwnd
' enumerate the list
lRet = EnumChildWindows(lhWnd, AddressOf EnumChildProc, lParam)

rs.close

end sub

Open in new window

0
 
LVL 84
ID: 35112293
Glad you got this fixed. I got busy earlier, sorry I bailed on you.
0
 
LVL 26

Author Comment

by:Nick67
ID: 35112446
No Biggie.
Sometimes the act of having to post it gets the juices flowing.
That, and making sure the code I post is going to work for someone else.
I knew I was getting the right handle because I could reposition the window.

That left child windows and trial-and-error
What would you like for points for your time, and how do I get them to you while accepting my own posting as the solution.

Nick67
0
 
LVL 84
ID: 35112773
You can select your own comment as the Solution, and close this. If you used any of my suggestions, then you can certainly award points to my posts, but if you didn't then please don't feel obligated to award any points.

0
 
LVL 26

Author Closing Comment

by:Nick67
ID: 35145572
SendKeys technically could work, but the known Sendkeys bug makes that unworkable.  LSMConsulting pointed in the right direction that there could be child windows involved
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

QuickBooks® has a great invoice interface that we were happy with for a while but that changed in 2001 through no fault of Intuit®. Our industry's unit names are dictated by RUS: the Rural Utilities Services division of USDA. Contracts contain un…
Introduction The Visual Basic for Applications (VBA) language is at the heart of every application that you write. It is your key to taking Access beyond the world of wizards into a world where anything is possible. This article introduces you to…
In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…
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 …

708 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

13 Experts available now in Live!

Get 1:1 Help Now