IShellWindows / IFolderView
There's some basic ways of working with open Explorer windows, but if you really want to do some intensive work with them, the IShellWindows interface lets you get a variety of other interfaces that allow you to get very detailed information about open windows and their items, as well as set view and selection options. You can get a direct line on the IShellBrowser, IShellView, IFolderView, and IShellFolder/IShellItem interfaces for all open folders using this method.
For the purposes of this demonstration, all we're doing is listing some details, but if you're not familiar with those interfaces already just look through their members in Object Browser to see all the other things you can get and set.
Requirements
-Sample project requires Vista+. Some info is retrieved with IFolderView2... but if you just stuck to what is available with IFolderView, you could use this in XP too.
-oleexp 3.4 or higher (released with this sample on 10 Jan 2016) - must add as reference if marked as missing
Technique
The IShellWindows interface conveniently has a default implementation coclass (ShellWindows), so setting up the window enumeration is straightforward. The sample shows 2 different ways to loop through the open windows:
Code:
Set oSW = New ShellWindows
If oSW.Count < 1 Then Exit Sub
ReDim sSelected(oSW.Count - 1)
'METHOD 1: .Item/.Count
'For q = 0 To oSW.Count - 1
' Set pdp = oSW.Item(CVar(q))
' Set punkitem = pdp
'---------------
'METHOD 2: IEnumVARIANT
Set spunkenum = oSW.NewEnum
Set spev = spunkenum
Do While spev.Next(1&, pVar, pclt) = NOERROR
Set punkitem = pVar
'---------------Now that we've got a Variant representing a window, first we get the IShellBrowser interface for it. After that we're golden... we can get the IShellView through .QueryActiveShellView, and then IShellView also implements IFolderView/IFolderView2, so all we need is the Set keyword (this internally calls QueryInterface that you see in the C++ examples of this). Then IFolderView has .GetFolder which can get the IShellItem or IShellFolder of the folder.
(critical error checking and debug logging code omitted, see full sample)
Code:
IUnknown_QueryService ObjPtr(punkitem), SID_STopLevelBrowser, IID_IShellBrowser, spsb 'get IShellBrowser
spsb.QueryActiveShellView spsv 'get IShellView
Set spfv = spsv 'get IFolderView2
spfv.GetFolder IID_IShellItem, lsiptr 'this is original olelib's problem having it as a long, which now needs:
If lsiptr Then vbaObjSetAddRef spsi, lsiptr 'get IShellItem---------------------------------------
Here's the full EnumWindows routine that fills the ListView in the sample (and the sSelection module-level holder of the contents) and some other supporters. Don't be scared of all the variables!
Code:
Private Sub EnumWindows()
Dim li As ListItem
Dim i As Long, j As Long
Dim s1 As String, s2 As String, s3 As String
Dim lp1 As Long, lp2 As Long, lp3 As Long, lp4 As Long, lp5 As Long
Dim siaSel As IShellItemArray
Dim lpText As Long
Dim sText As String
Dim sItems() As String
Dim punkitem As oleexp3.IUnknown
Dim lPtr As Long
Dim pclt As Long
Dim spsb As IShellBrowser
Dim spsv As IShellView
Dim spfv As IFolderView2
Dim spsi As IShellItem
Dim lpPath As Long
Dim sPath As String
Dim lsiptr As Long
Dim ct As Long
Dim oSW As ShellWindows
Dim spev As oleexp3.IEnumVARIANT
Dim spunkenum As oleexp3.IUnknown
Dim pVar As Variant
Dim pdp As oleexp3.IDispatch
Dim q As Long
Dim tSC(10) As SORTCOLUMN
Set oSW = New ShellWindows
If oSW.Count < 1 Then Exit Sub
ReDim sSelected(oSW.Count - 1)
'METHOD 1: .Item/.Count
'For q = 0 To oSW.Count - 1
' Set pdp = oSW.Item(CVar(q))
' Set punkitem = pdp
'---------------
'METHOD 2: IEnumVARIANT
Set spunkenum = oSW.NewEnum
Set spev = spunkenum
Do While spev.Next(1&, pVar, pclt) = NOERROR
Set punkitem = pVar
'---------------
ct = ct + 1
Debug.Print "in loop " & ct
If True Then
If (punkitem Is Nothing) = False Then
Debug.Print "queryservice"
IUnknown_QueryService ObjPtr(punkitem), SID_STopLevelBrowser, IID_IShellBrowser, spsb
If (spsb Is Nothing) = False Then
Debug.Print "queryview"
spsb.QueryActiveShellView spsv
If (spsv Is Nothing) = False Then
Set spfv = spsv
Debug.Print "getfolder"
spfv.GetFolder IID_IShellItem, lsiptr ' spsi
If lsiptr Then vbaObjSetAddRef spsi, lsiptr
If (spsi Is Nothing) = False Then
'we've got all relevant interfaces, start adding data
spsi.GetDisplayName SIGDN_NORMALDISPLAY, lpPath
sPath = LPWSTRtoStr(lpPath)
Debug.Print "Open path " & sPath
Set li = ListView1.ListItems.Add(, , sPath)
spfv.ItemCount SVGIO_ALLVIEW, lp1
spfv.ItemCount SVGIO_SELECTION, lp2
spfv.GetSortColumnCount lp3
If lp3 > 11 Then lp3 = 11
spfv.GetSortColumns tSC(0), lp3
For j = 0 To lp3
If PSGetNameFromPropertyKey(tSC(j).PropKey, lpText) = S_OK Then
sText = sText & LPWSTRtoStr(lpText) & "(" & tSC(j).direction & ") "
Else
Debug.Print "sortcol name needs psstringfrompropertykey; not implemented in this sample"
End If
Next
spfv.GetViewModeAndIconSize lp4, lp5
With li
.SubItems(1) = lp1
.SubItems(2) = lp2
.SubItems(3) = sText
.SubItems(4) = ViewModeStr(lp4)
spsi.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpPath
sPath = LPWSTRtoStr(lpPath)
.SubItems(5) = sPath
End With
If lp2 > 0& Then
spfv.GetSelection 0&, siaSel
If (siaSel Is Nothing) = False Then
sSelected(ct - 1) = GetNamesFromSIA(siaSel)
End If
Else
sSelected(ct - 1) = "(none)"
End If
Else
Debug.Print "Failed to get IShellItem"
End If
Else
Debug.Print "Failed to get IShellView"
End If
Else
Debug.Print "Failed to get IShellBrowser"
End If
Else
Debug.Print "Failed to cast enum lPtr to pUnk"
End If
Else
Debug.Print "in loop but lptr=0"
End If
Set spsi = Nothing
Set spsv = Nothing
Set spsb = Nothing
lsiptr = 0
lp1 = 0
lp2 = 0
lp3 = 0
lp4 = 0
Erase tSC
'switch to next for method 1
Loop
'Next
End Sub
Private Function GetNamesFromSIA(psia As IShellItemArray, Optional nType As SIGDN = SIGDN_NORMALDISPLAY) As String
Dim pEnum As IEnumShellItems
Dim psi As IShellItem
Dim lp As Long
Dim s1 As String
Dim sOut As String
Dim pcl As Long
psia.EnumItems pEnum
If (pEnum Is Nothing) Then Exit Function
Do While (pEnum.Next(1&, psi, pcl) = NOERROR)
psi.GetDisplayName nType, lp
sOut = sOut & LPWSTRtoStr(lp) & ", "
Loop
If Len(sOut) > 2 Then
sOut = Left$(sOut, Len(sOut) - 2) 'remove trailing comma
End If
GetNamesFromSIA = sOut
End Function