Hi All
I had a quick look back at this thread an realised it’d been a while since I’d had a good look.
I’ve since been using yet another version of the non-VBA DP version of this utility - originally Dave Rathburns - that I tweaked a little.
It has a couple of little improvements:
Uses For Each loops which seem more stable and execute more quickly
Fetches document variables and formulae alike
Makes all output ‘CSV Safe’ to prevent read-in errors.
Toggles Interactive mode to improve visual feedback
I hope this helps out…
' Objects Used utility
' Orignal by Dave Rathburn
' Tweaked and expanded by Phil Morris - IT Performs
' Code is provided as-is,
' No warranty of any kind is implied nor will any
' liabilities be accepted for any problems losses etc.
' incurred by the use of this code.
' License: Beerware
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
Global Const qc As String = """"
Sub ObjectsUsed()
Dim strCurrentFile As String
Dim docMyDocument As Document
Dim dpMyDataProvider As DataProvider
Dim qryMyQuery As Query
Dim resMyResult As Result
Dim varMyVariable As DocumentVariable
Dim cndMyCondition As Condition
Dim dpColumn As Column
Dim strUniverseName As String
Dim strUniverseDomain As String
Dim strNextItem As String ' used to parse comma listed table names
Dim strDocPath As String ' Path to use to look for files
Dim strObjList As String ' Path for output file
Dim strErrorLog As String ' Path for error log
Dim i, j, k, l, n As Integer ' loop counters
Dim x As Integer ' function result value
Dim strAllQV As String ' String to contain the array of known query objects, for filtering variable results
' Start directory list of .rep files in the standard file location. If you want to load files
' from a different directory, you would hard code the value below. Make sure that a hard-coded
' path includes the trailing back slash!
strDocPath = Application.GetInstallDirectory(boDocumentDirectory) & "\ObjectsUsed\"
strObjList = strDocPath & "ObjectsUsed.csv"
strErrorLog = strDocPath & "ObjectsUsed.log"
If FileExist(strObjList) Then
Kill (strObjList)
End If
If FileExist(strErrorLog) Then
Kill (strErrorLog)
End If
strCurrentFile = Dir(strDocPath & "*.rep")
Open strObjList For Append As OutNum
Print #OutNum, "Universe"; ", "; "Report Name"; ", "; "Class Name"; ", "; "Object Name"; ", Clause"
' Do while there are reports we have not looked at
Do While strCurrentFile <> ""
If strCurrentFile <> ThisDocument.Name & ".rep" Then
' Suppress any unwanted messages
Application.Interactive = False
Set docMyDocument = Application.Documents.Open(strDocPath & strCurrentFile, True, True)
If docMyDocument.Name <> "" 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 provideres and write out to
' an output file the comma separated list of objects used
strAllQV = ""
For Each qryMyQuery In dpMyDataProvider.Queries
For Each resMyResult In qryMyQuery.Results
Call PrintToFile(strUniverseName _
, strCurrentFile _
, resMyResult.Class _
, resMyResult.Object _
, "QObject" _
)
strAllQV = strAllQV + "|" + resMyResult.Object
Next resMyResult
For Each cndMyCondition In qryMyQuery.Conditions
Call PrintToFile(strUniverseName _
, strCurrentFile _
, cndMyCondition.Class _
, cndMyCondition.Object _
, "Condition" _
)
Next cndMyCondition
Next qryMyQuery
End If
Next dpMyDataProvider ' Next data provider, if any more
' this is a loop to output variables and formulae in the document.
For Each varMyVariable In docMyDocument.DocumentVariables
If InStr(1, strAllQV, "|" + varMyVariable.Name) = 0 _
Or varMyVariable.Name = "" Then
If varMyVariable.Name = "" Then
Call PrintToFile(strUniverseName _
, strCurrentFile _
, "Formula" _
, varMyVariable.Formula _
, "Formula" _
)
Else
' NOW USE PRINT SUB Print #OutNum, qc; strUniverseName; qc; ", "; strCurrentFile; ", "; docMyDocument.DocumentVariables.Item(k).Name; ", "; docMyDocument.DocumentVariables.Item(k).Formula; ", "; "Variable"
Call PrintToFile(strUniverseName _
, strCurrentFile _
, varMyVariable.Name _
, varMyVariable.Formula _
, "Variable" _
)
End If
End If
Next varMyVariable
End If
' Go interactive again in the hope that we might see progress
Application.Interactive = True
docMyDocument.Close
End If
'skipme:
' Get next document, if there is one.
strCurrentFile = Dir
Loop
Close OutNum
' If this document includes a link to the CSV file as a data provider,
' then the following lines can be used to refresh the list of objects.
ThisDocument.Activate
ThisDocument.Refresh
k = MsgBox("Document Analysis Complete!", vbOKOnly, "Document Structure Macro")
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(ErrorString$)
Dim strErrorLog As String
strErrorLog = Application.GetInstallDirectory(boDocumentDirectory) & "\ObjectsUsed.log"
Open strErrorLog For Append As #ErrNum
Print #ErrNum, Now; " > "; ErrorString$
Close #ErrNum
End Sub ' LogError
'*********************************************************************
' This subroutine is used to format and output to the main file
' It accepts 1 string parameter for each of the 5 output columns
'*********************************************************************
Sub PrintToFile(ByVal ov_Universe$, ByVal ov_Report$, ByVal ov_Class$, ByVal ov_Object$, ByVal ov_Clause$)
' First pass all of the columns through the CSV safe function
ov_Universe$ = MakeCSVSafe(ov_Universe$)
ov_Report$ = MakeCSVSafe(ov_Report$)
ov_Class$ = MakeCSVSafe(ov_Class$)
ov_Object$ = MakeCSVSafe(ov_Object$)
ov_Clause$ = MakeCSVSafe(ov_Clause$)
' Now output to the file
Print #OutNum, ov_Universe$; ","; ov_Report$; ","; ov_Class$; ","; ov_Object$; ","; ov_Clause$
End Sub ' PrintToFile
'*********************************************************************
' This function is used to check for the existance of a file. It returns
' a fake "boolean" flag using the BusinessObjects constants TRUE and FALSE.
' If the file is found, the function returns TRUE. Otherwise, the function
' returns FALSE.
'
' If any file name is not found, an entry is made to the LogFile.
'*********************************************************************
Function FileExist(myFileName$)
' First Check to ensure that myFileName is a valid file
On Error GoTo NotFound ' provide alternate error handling
Open myFileName$ For Input As 255 ' attempt to open file
On Error Resume Next ' if success, restore default error handling
Close 255 ' close file (it was only a test, afterall)
FileExist = True
Exit Function
NotFound:
On Error Resume Next
FileExist = False
LogError ("File " & myFileName$ & " not found.")
End Function ' File Exist
'*********************************************************************
' This function is used to convert output strings to a safe format for
' the output CSV file.
' This includes surrounding the main string with double quotes,
' to ensure any commas contained within are taken literally
' Changing any incidences of double quotes into 2, to mean literal "
'*********************************************************************
Function MakeCSVSafe(term)
Dim m As Integer
Dim bs As String
bs = qc 'initialise build string with a double quote
If InStr(1, term, qc) Then
For m = 1 To Len(term)
If Mid$(term, m, 1) = qc Then
bs = bs + qc + qc
Else
bs = bs + Mid$(term, m, 1)
End If
Next m
Else
bs = bs + term
End If
bs = bs + qc
MakeCSVSafe = bs
End Function
philmorris (BOB member since 2002-11-12)