Author: Dave Rathbun
Author Notes:
Objects Used
' "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.
' This code may be used for personal or corporate use, but may not
' be sold, redistributed, or posted on web sites without permission
' from the author.
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
Sub ObjectsUsed()
Dim strCurrentFile As String
Dim docMyDocument As Document
Dim dpMyDataProvider As DataProvider
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 As Integer ' loop counters
Dim x As Integer ' function result value
' 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) & "\Integra Solutions\"
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"; ", "; "Object Name"; ", X"
Close #OutNum
' Do while there are reports we have not looked at
Do While strCurrentFile <> ""
If strCurrentFile <> ThisDocument.Name & ".rep" Then
Set docMyDocument = Application.Documents.Open(strDocPath & strCurrentFile)
If docMyDocument.Name <> "" Then
For j = 1 To docMyDocument.DataProviders.Count
Set dpMyDataProvider = docMyDocument.DataProviders.Item(j)
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
Open strObjList For Append As OutNum
For k = 1 To dpMyDataProvider.Columns.Count
Print #OutNum, strUniverseName; ", "; strCurrentFile; ", "; dpMyDataProvider.Columns.Item(k).Name; ", "; "X"
Next k
Close OutNum
End If
Next j ' Next data provider, if any more
End If
docMyDocument.Close
End If
' Get next document, if there is one.
strCurrentFile = Dir
Loop
' 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
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, Date; " "; Time(); " > "; ErrorString$
Close #ErrNum
End Sub ' LogError
'*********************************************************************
' 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
BOB Downloads (BOB member since 2003-05-05)