Code to list concurrently open workbooks

[DaveO]

From the Excel menu you can click >Windows and see a list of
concurrently open files. Is there VBA code to capture that list
programmatically?

For instance: to touch all the cells in a selection, the code is
For Each rCell in Selection.Cells
...snip
next rCell

Is there similar For Each code that will scroll through a list of open
workbooks?

Thanks,
Dave O

 

[RB Smissaert]

Try something like this:

Sub test()

Dim oWB As Workbook
Dim oAddin As AddIn

For Each oWB In Application.Workbooks
MsgBox oWB.Name
Next oWB

For Each oAddin In Application.AddIns
If oAddin.Installed Then
MsgBox oAddin.Name
End If
Next oAddin

End Sub


RBS

 

[DaveO]

That's what I was looking for, thanks!

 

[RB Smissaert]

The posted code will miss out on add-ins that are open, but not loaded as an
add-in.
This code will correct that:

Sub test2()

Dim i As Long
Dim oProject
Dim oWB As Workbook
Dim collWorkbooks As Collection

Set collWorkbooks = New Collection

On Error Resume Next

For Each oProject In Application.VBE.VBProjects
collWorkbooks.Add FileFromPath(oProject.Filename, False), _
FileFromPath(oProject.Filename, False)
Next oProject

For Each oWB In Application.Workbooks
collWorkbooks.Add FileFromPath(oWB.Name, False), _
FileFromPath(oWB.Name, False)
Next oWB

For i = 1 To collWorkbooks.Count
MsgBox collWorkbooks(i)
Next i

End Sub


RBS

 

[RB Smissaert]

Forgot to post the FileFromPath function:

Function FileFromPath(ByVal strFullPath As String, _
Optional bExtensionOff As Boolean) As String

Dim FPL As Long 'len of full path
Dim PLS As Long 'position of last slash
Dim pd As Long 'position of dot before exension
Dim strFile As String

On Error GoTo ERROROUT

FPL = Len(strFullPath)
PLS = InStrRev(strFullPath, "\", , vbBinaryCompare)
strFile = Right$(strFullPath, FPL - PLS)

If bExtensionOff = False Then
FileFromPath = strFile
Else
pd = InStr(1, strFile, ".", vbBinaryCompare)
FileFromPath = Left$(strFile, pd - 1)
End If

Exit Function
ERROROUT:

End Function


RBS