Here is the new code using a slightly different approach which is more reliable.
This piece of code is reading the report attached to the script, in order to get the parameters, so that a user can type his parameters directly in the report’s cells instead of using some database and/or Excel spreadsheet.
Then it is looping through the list of reports, looping based on one SQL order in order to refresh them for some different values, and publish a copy of the refreshed report back in the Corporate Document list.
I guess the loop to get the list of cell starts at “For Each objRep In objDoc.Reports” and ends up pretty much at “Initialising Parameters From the Report”.
But I thought you would be interested in the whole report.
I can’t copy the report itself not even a screen copy so it may be difficult to have it, but if you are interested, just drop me an email.
This script combines, Reading the Report Structure, running some SQL through ODBC as well as publishing back to the repository.
The following piece of code needs to be Cut & Paste in the VBA windows under the Module area, well that is the way I used to do it
( Don’t tell me it is not working as we use that script in Production now and works like a charm ;-), we are using BusinessObjects 5.1.5 )
Option Explicit
'Database & Repository Constants
Public objCon As ADODB.Connection
Sub Main()
Dim objDoc As busobj.Document
Dim objStruct As busobj.SectionStructure
Dim objStructItem As busobj.ReportStructureItem
Dim objBlock As busobj.BlockStructure
Dim objPivot As busobj.Pivot
Dim objDocVar As busobj.DocumentVariable
Dim vars As DocumentVariables
Dim var As DocumentVariable
Dim objRS As ADODB.Recordset
Dim objRep As busobj.Report
Dim strDocDir As String
Dim strPromptValue As String
Dim strAlternativeField As String
Dim doc As Document
Dim ObjectCounter As Integer
Dim strMsg As String
Dim CONNECTION_STR As String
Dim EXCH_DOMAIN As String
' Report Constants
Dim DOC_NAME As String
Dim REPORT_PROMPT As String
Dim DOC_CATEGORY As String
Dim USER_GROUP As String
' Prompt Constants
Dim SQL_STRING As String
Dim PROMPT_VALUE As String
Dim CalendarMonth As String
Dim FinancialYear As String
' Set to the previous calendar Month
If Month(Now()) = 1 Then
CalendarMonth = Str(12)
Else
CalendarMonth = Str(Month(Now()) - 1)
End If
' Set the Financial Year
If Val(CalendarMonth) >= 10 Then
FinancialYear = Str(Year(Now()) + 1)
Else:
FinancialYear = Str(Year(Now()))
End If
' ----------START FOR CELL LOOP ------
Set doc = Application.ActiveDocument
Set vars = doc.DocumentVariables
Set objDoc = Application.ActiveDocument
For Each objRep In objDoc.Reports
Set objStruct = objRep.GeneralSectionStructure
ObjectCounter = 1
For Each objStructItem In objStruct.Body
Select Case objStructItem.Type
Case boCell
Select Case ObjectCounter
Case 2
DOC_NAME = objStructItem.Variable.Formula
Case 6
REPORT_PROMPT = objStructItem.Variable.Formula
Case 7
DOC_CATEGORY = objStructItem.Variable.Formula
Case 10
SQL_STRING = objStructItem.Variable.Formula
Case 11
CONNECTION_STR = objStructItem.Variable.Formula
Case 14
EXCH_DOMAIN = objStructItem.Variable.Formula
Case 16
PROMPT_VALUE = objStructItem.Variable.Formula
Case 18
USER_GROUP = objStructItem.Variable.Formula
End Select
End Select
ObjectCounter = ObjectCounter + 1
Next
Next
' Initialising Parameters From the Report
'MsgBox CONNECTION_STR
'MsgBox EXCH_DOMAIN
'MsgBox DOC_NAME
'MsgBox REPORT_PROMPT
'MsgBox DOC_CATEGORY
'MsgBox SQL_STRING
'MsgBox PROMPT_VALUE
'MsgBox USER_GROUP
' ----------END FOR CELL LOOP ------
Dim ReportName As String
Dim WorkingReport As String
Dim StrStart As Integer
Dim StrEnd As Integer
strDocDir = Application.GetInstallDirectory(boDocumentDirectory)
If Dir(strDocDir, vbDirectory) = "" Then
Err.Raise 63000
End If
' Setting up the Repository Access
Application.ExchangeMode = boRepositoryMode
Application.ExchangeDomain = EXCH_DOMAIN
' Looping through a list of Reports
WorkingReport = DOC_NAME
If Right(WorkingReport, 1) <> ";" Then WorkingReport = WorkingReport + ";"
While Len(WorkingReport) > 0
StrEnd = InStr(1, WorkingReport, ";", 1)
ReportName = Mid(WorkingReport, 1, StrEnd - 1)
'MsgBox ReportName
WorkingReport = Mid(WorkingReport, StrEnd + 1, Len(WorkingReport) - StrEnd + 1)
' Retrieving the Document from the Repository (Document Domain specified in EXCH_DOMAIN)
Application.Documents.Receive ReportName, strDocDir
Set objDoc = Application.Documents.Open(ReportName & ".rep")
' Setting ODBC connection
Set objCon = New Connection
objCon.Open CONNECTION_STR
If Err.Number <> 0 Then
Err.Raise 63001
End If
Set objRS = New ADODB.Recordset
objRS.Open SQL_STRING, objCon, adOpenKeyset, adLockOptimistic
If Err.Number <> 0 Then
Err.Raise 63002
End If
While Not objRS.EOF
' Setting the
strPromptValue = objRS.Fields(PROMPT_VALUE)
strAlternativeField = Trim(objRS.Fields("AlternativeField"))
' Setting the value of the prompt based on the selected value in the SQL
Application.Variables.Item(REPORT_PROMPT).Value = strPromptValue
' Setting the Refreshing Mode to Batch
Application.Variables.Item("Select Refresh Mode (Batch Refresh = B/ User Refresh = U)").Value = "B"
Application.Variables.Item("Select Calendar Month").Value = Trim(CalendarMonth)
Application.Variables.Item("Select Financial Year").Value = Trim(FinancialYear)
' Refreshing the report
Application.Interactive = False
Application.Documents(ReportName).Refresh
' Replacing the "/" by an hyphen "-"
If InStr(1, strPromptValue, "/", 1) <> 0 Then
Mid(strPromptValue, InStr(1, strPromptValue, "/", 1), 1) = "-"
End If
' Changing the name of the report to reflect the level (Entity / Project)
Application.Documents(ReportName).SaveAs strDocDir & "\" & ReportName & "_" & strPromptValue & ".rep"
' Publishing the report to the repository in the right category
Application.Interactive = False
If strAlternativeField <> "" Then
Application.Documents(ReportName & "_" & strPromptValue).Send USER_GROUP, , , strAlternativeField & " " & DOC_CATEGORY, , EXCH_DOMAIN
Else
Application.Documents(ReportName & "_" & strPromptValue).Send USER_GROUP, , , strPromptValue & " " & DOC_CATEGORY, , EXCH_DOMAIN
End If
Application.Interactive = True
' Changing back the name of the report
Application.Documents(ReportName & "_" & strPromptValue).SaveAs strDocDir & "\" & ReportName & ".rep"
objRS.MoveNext
Wend
If objRS.State = 1 Then 'recordset is opened
objRS.Close
End If
If objCon.State = 1 Then 'connection is opened
objCon.Close
End If
Set objRS = Nothing
Set objCon = Nothing
Wend
'Application.Interactive = True
Exit Sub
End Sub
eVolition (BOB member since 2002-09-01)