I’ve adapted Dave’s excellent code to search sub folders and include objects used in the conditions.
It requires a reference to Microsoft Scripting Runtime - in the VBA editor, select Tools/References and tick the Microsoft Scripting Runtime.
'requires a reference to Microsoft Scripting Runtime
' - select Tools/References from the menu
' find Microsoft Scripting Runtime and TICK the box.
' if you don't have it listed, it's available as a free download from
' www.microsoft.com
'Modified by Chris Hogben
'Modifications: -
' Searches sub folders
' includes objects used in conditions if they aren't returned
' lists path and filename seperately
' lists document author and the last time the report was modified
' changed some of the loops to use for each
' changed the code to check if a file exists
' will save the results and errors in the 'root' folder
' deletes the error file
' set application.interactive to false to avoid the program pausing because of obsolete objects
' if there's an error opening the document - then the program will log it and move on to the next file
' changed the name of the error log
'
' "ObjectsUsed"
' Dave Rathbun, Integra Solutions
' www.IntegraSolutions.net
' provided "as is", no warranty implied
' This macro does not by design to anything to the reports that it reads. It does write
' to a CSV file that will be - by default - located in the "UserDocs" folder as specified by
' a user preference setting. The data provider for the document must point to this file. As of
' this revision, the user must do this step manually.
Option Explicit ' Force explicit declaration of all variables
' GLOBAL CONST *******************************************************
' Standard File I/O numbers assigned here
Global Const ErrNum As Integer = 1
Global Const OutNum As Integer = 2
Private m_strDocPath As String
Private m_strObjList As String
Private m_strDPList As String
Private m_strErrorLog As String
Private m_strThisDocumentName As String
Public Sub RecurseAllSubFoldersStart()
m_strDocPath = InputBox(prompt:="Please enter the root path", _
Default:="c:\")
If Len(m_strDocPath) = 0 Then
MsgBox "aborted"
Exit Sub
Else
If Right$(m_strDocPath, 1) <> "\" Then
m_strDocPath = m_strDocPath & "\"
End If
If Len(Dir(m_strDocPath)) = 0 Then
MsgBox "Cannot find folder, aborted"
Exit Sub
End If
End If
Application.Interactive = False
m_strObjList = m_strDocPath & "ReportDictionary_ObjectsUsed.csv"
m_strDPList = m_strDocPath & "ReportDictionary_SQLUsed.csv"
m_strErrorLog = m_strDocPath & "ReportDictionary_Error.log"
m_strThisDocumentName = ThisDocument.Name & ".rep"
'set up output files
If Len(Dir(m_strObjList)) <> 0 Then
Kill (m_strObjList)
End If
If Len(Dir(m_strObjList)) <> 0 Then
Kill (m_strErrorLog)
End If
If Len(Dir(m_strDPList)) <> 0 Then
Kill (m_strDPList)
End If
Open m_strObjList For Append As OutNum
'Print #OutNum, "Universe(Domain)"; ", "; "Report Name"; ", "; "Object Name"
Print #OutNum, "Report Path,Report Name,Author,Date Last Modified, Universe,Object"
Close #OutNum
Open m_strDPList For Append As OutNum
Print #OutNum, "Universe(Domain)"; ", "; "Report Name"; ", "; "DP Name"; ", SQL Code"
Close #OutNum
RecurseFolders strFoldername:=m_strDocPath
Application.Interactive = True
End Sub
Private Function RecurseFolders(ByVal strFoldername As String) As Boolean
Dim objFSO As FileSystemObject
Dim objFolder As Folder
Dim objFiles As Files
Dim objFile As File
Dim strFileName As String
Dim objSubFolders As Folders
Dim objSubFolder As Folder
Dim strFolderpath As String
On Error Resume Next
Set objFSO = New FileSystemObject
If Err.Number > 0 Then
RecurseFolders = False
Exit Function
End If
On Error GoTo 0
If objFSO.FolderExists(strFoldername) Then
Set objFolder = objFSO.GetFolder(strFoldername)
Set objSubFolders = objFolder.SubFolders
For Each objSubFolder In objSubFolders
RecurseFolders (objSubFolder.Path)
Next
strFolderpath = objFolder.Path
If Right$(strFolderpath, 1) <> "\" Then
strFolderpath = strFolderpath & "\"
End If
For Each objFile In objFolder.Files
With objFile
strFileName = LCase$(.Name)
If Right$(strFileName, 3) = "rep" Then
If objFile.Name <> m_strThisDocumentName Then
'Debug.Print objFile.Path
ObjectsUsed strPath:=strFolderpath, _
strFileName:=.Name, _
strDateLastModified:=Format$(.DateLastModified, "dd/mm/yyyy")
End If
End If
End With
Next
Set objFolder = Nothing
Set objSubFolder = Nothing
Set objFile = Nothing
Else
RecurseFolders = False
End If
Set objFSO = Nothing
End Function
Private Sub ObjectsUsed(ByVal strPath As String, ByVal strFileName As String, ByVal strDateLastModified As String)
Dim docMyDocument As Document
Dim dpMyDataProvider As DataProvider
Dim objColumn As Column
Dim strUniverseName As String
Dim strThisDocumentName As String
Dim objCondition As Condition
Dim objQuery As Query
Dim strColumns As String
Dim strConditionObject As String
On Error Resume Next
Set docMyDocument = Application.Documents.Open(strPath & strFileName, True, True)
If Err.Number <> 0 Then
Debug.Print "unable to open " & strPath And strFileName
LogError "unable to open " & strPath And strFileName
Exit Sub
End If
On Error GoTo 0
If Len(docMyDocument.Name) <> 0 Then
For Each dpMyDataProvider In docMyDocument.DataProviders
If dpMyDataProvider.GetType = "DPQTC" Then ' This is a dataprovider from a universe
' Get the universe associated with the data provider
strUniverseName = dpMyDataProvider.UniverseName
' Next step will be to parse the data providers and write out to
' an output file the comma separated list of objects used
Open m_strObjList For Append As OutNum
'data provider objects used as results
strColumns = "" ' build up a string of columns used as results
For Each objColumn In dpMyDataProvider.Columns
strColumns = strColumns & "," & objColumn.Name
Print #OutNum, strPath & "," & strFileName & "," & docMyDocument.Author & "," & strDateLastModified & "," & strUniverseName & "," & objColumn.Name
Next
'data provider objects used as conditions
For Each objQuery In dpMyDataProvider.Queries
For Each objCondition In objQuery.Conditions
strConditionObject = objCondition.Object
'check if we've already output this object by checking the strColumns string
If InStr("," & strConditionObject, strColumns) = 0 Then
'condition object isn't a result object as well - output it
Print #OutNum, strPath & "," & strFileName & "," & docMyDocument.Author & "," & strDateLastModified & "," & strUniverseName & "," & strConditionObject
End If
Next
Next
Close OutNum
Open m_strDPList For Append As OutNum
Print #OutNum, strUniverseName; ", "; strFileName; ", "; dpMyDataProvider.Name; ","; Chr(34) & dpMyDataProvider.SQL & Chr(34)
Close OutNum
End If
Next ' Next data provider, if any more
End If
docMyDocument.Close
'ThisDocument.Activate
Set objColumn = Nothing
Set objCondition = Nothing
Set objQuery = Nothing
Set docMyDocument = Nothing
Set dpMyDataProvider = Nothing
End Sub
'*********************************************************************
' This subroutine is used to log entries to a specified log file. The
' only error that is not logged here is a failure to write to the log
' file...
'*********************************************************************
Sub LogError(ByVal ErrorString As String)
Open m_strErrorLog For Append As #ErrNum
Print #ErrNum, Now(); " > "; ErrorString$
Close #ErrNum
End Sub
Hope it’s useful
chrishogben (BOB member since 2003-06-26)
(BOB member since 2002-07-17)
although I did tell him I had help from 
(BOB member since 2002-06-20)
I’ll either mail it to you directly, or posted it as a supplement to the BOB’s Downloads topic.