BusinessObjects Board

save each prompt value as a separate sheet in one excel file

sdk development
#1

Hello All,

how can i save each prompt value as a separate excel sheet(tab) in a single excel file

example:
in my report user will select countries from the prompt then VBA code will create a single excel file that includes all country report will be as a separate sheet in that excel file

presently my below code will generate each account (user selected from priompt ) as a new excel file, but i need, each account (user selected from prompt ) as a new sheet in single excel file

Option Explicit

’ Hardcoded variables
Const strFilterVar As String = “CODE” ’ Filter object name
Const ReportSavePath As String = “C:\Documents and Settings\Daily”

Dim finalSavePath As String

Dim sDate As String
Dim sTime As String
Dim FilterDynArr() As String
Dim boolFilVarExist As Boolean
Dim DocName As String
Private Sub Document_AfterRefresh()
DistributeDocument
End Sub
’ Distribution starts here
Sub DistributeDocument()
Dim doc As Document
Dim DocVarName As String
Dim DocVarCnt As Integer
On Error Resume Next

Set doc = ThisDocument
DocName = doc.Name

' Get Current date
sDate = Format(Now, "yyyymmdd")
' Scan all report objects for filter variable
boolFilVarExist = False

For DocVarCnt = 1 To doc.DocumentVariables.Count
 ' Getting each report object name to local variable
  DocVarName = doc.DocumentVariables.Item(DocVarCnt).Name
  If DocVarName = strFilterVar Then
     boolFilVarExist = True
     Exit For
  End If
Next DocVarCnt
        
CreateFolders ReportSavePath, True


' if filtervariable exist in the report then execute the sub procedures
 If boolFilVarExist Then
   GetSelectedFilterListValues doc
   ApplyFilter doc
 End If

Set doc = Nothing

End Sub

'Reads the selected values by the user in the prompt(Filter Variables)
'After Process, Each Selected Value Writes to the Array Locations
'Param:[doc] The Documnet it needs to get the Selected Prompt Values
Private Sub GetSelectedFilterListValues(doc As Document)
Dim part As Variant
Dim cntFilters As Long
Dim thisDoc As Document
Dim i As Integer
Dim currPos, startAt As Integer
currPos = 1
Dim str1, str2 As Variant

ReDim FilterDynArr(0)
cntFilters = 0
startAt = 1

’ Get list of values for Filter object
If (ThisDocument.DataProviders(1).NbRowsFetched <> -1) Then
’ Loop through all Documet Variables To get User Prompt Values
For i = 1 To ActiveDocument.Variables.Count
’ Checking the current variable is User Prompt?
If ThisDocument.Variables.Item(i).IsUserPrompt = True Then
’ Checking for Select Account user prompt
If ThisDocument.Variables.Item(i).Name = “Select Group” Then
’ Getting all selected values by the user from prompt to the local variable
str1 = ThisDocument.Variables.Item(i).Value
’ Adding ; at the end of all values if not exist
If Not Right(str1, 1) = “;” Then str1 = str1 + “;”
’ Loop through each selected value and store it in an Array
'While (str1 <> “”)
While (Len(str1) <> currPos)
’ Finding next position of ;(separator for selected values)
currPos = InStr(startAt, str1, “;”)
’ Getting Each Selected Value from the whole Selected Value String
str2 = Mid(str1, startAt, currPos - startAt)
’ Increase size of array
ReDim Preserve FilterDynArr(UBound(FilterDynArr) + 1)
’ Storing Each Selected value to Array
FilterDynArr(cntFilters) = UCase(str2)
cntFilters = cntFilters + 1
startAt = currPos + 1
Wend
End If
End If
Next i 'end looop
End If
End Sub
'Applies filter for each value in an Array To generate individual reports
'After Process, Each Filter Value from Array will Have a result and will saves the report
'Param:[doc] The Documnet it needs to apply filter
Sub ApplyFilter(doc As Document)
Dim cntFil As Long
Dim RptCnt As Long
Dim strFilter As String
'To Read the Values from the First Location of array to the last Location of Array
For cntFil = LBound(FilterDynArr) To UBound(FilterDynArr) - 1
'making string filter with Each Array Value
strFilter = “=<” + strFilterVar + “>=” & “”"" & FilterDynArr(cntFil) & “”""
'for all reports in the current Document
For RptCnt = 1 To doc.Reports.Count
Call doc.Reports(RptCnt).AddComplexFilter(strFilterVar, strFilter)
doc.Reports(RptCnt).ForceCompute
Next RptCnt
'saving Documnet with the name from Current Array Location
SaveDocument doc, FilterDynArr(cntFil)
Next cntFil
End Sub
'Save document as Excel file
'Applies filter for each value in an Array To generate individual reports
'After Process, Each Filter Value from Array will Have a result and will saves the report
'Param:[doc] The Documnet to Save
'Param:[strFilterName] Name of the Account to include in File Name
Private Sub SaveDocument(doc As Document, strFilterName As String)
Dim cntSave As Long
Dim SaveAsPath As String
'Dim DocName As String
'SaveAsPath = ReportSavePath
SaveAsPath = finalSavePath
’ if the path don’t have a \ at the end then add it
If Right(SaveAsPath, 1) <> “” Then
SaveAsPath = SaveAsPath & “”
End If
’ formatting filepath and filename
SaveAsPath = SaveAsPath & "Credit Line & Collateral Report for " & strFilterName
'saving as excel file
doc.SaveAs (SaveAsPath & “.xls”)
’ ExcelFileFormat SaveAsPath & “.xls”, strFilterName
End Sub
'Create a folder for given path and if true create date folder under it
'Param:[sPathName] actual Saving path that needs to create if not exist
'Param:[bDate] Boolean if true then needs to create curreny day folder if not exist
Sub CreateFolders(sPathName As String, bDate As Boolean)
'MsgBox "Active station and folder name: " & CurDir

    Dim sDirPathName As String
    sDirPathName = sPathName
    'if not exist then make directory
    If Dir(sDirPathName, vbDirectory) = "" Then MkDir sDirPathName
    If Right(sDirPathName, 1) <> "\" Then sDirPathName = sDirPathName &amp; "\"
    'if folder with currentdy (yyyymmdd) not exist in the path then create it
      
Dim ski2 As String

ski2 = Left(Format(Now, "yyyymmdd"), 4)
sDirPathName = sDirPathName &amp; ski2
If Dir(sDirPathName, vbDirectory) = "" Then MkDir sDirPathName
If Right(sDirPathName, 1) <> "\" Then sDirPathName = sDirPathName &amp; "\"

ski2 = Left(Right(Format(Now, "yyyymmdd"), 4), 2)
sDirPathName = sDirPathName &amp; ski2
If Dir(sDirPathName, vbDirectory) = "" Then MkDir sDirPathName
If Right(sDirPathName, 1) <> "\" Then sDirPathName = sDirPathName &amp; "\"

ski2 = Right(Format(Now, "yyyymmdd"), 2)
sDirPathName = sDirPathName &amp; ski2
If Dir(sDirPathName, vbDirectory) = "" Then MkDir sDirPathName

finalSavePath = sDirPathName

'    If (bDate) Then
'        sDirPathName = sDirPathName &amp; sDate
'        If Dir(sDirPathName, vbDirectory) = "" Then MkDir sDirPathName
'    End If

End Sub

Thanks in advance

Best Regards
dhani

dhani (BOB member since 2007-05-21)

#2

Tp pass a prompt each time to a report and insert a tab in Excel sheet will need to be done either on Excel side or in BOBJ. Which may not be possible by enhancing the code you have attached.
Search BOB for the same, I remember seeing such codes where the Excel application is called in BOBJ or vice versa.

.

haider :es: (BOB member since 2005-07-18)

#3

Here’s another approach that won’t require using the Excel object model. Create all the individually filtered tabs in a single .rep file, then save the result as Excel. There is some code here that can get you started … Create report tab and filter for each value. Add the piece that saves as Excel, then DON’T save the .rep file itself.

Dwayne Hoffpauir :us: (BOB member since 2002-09-19)