A customer asked me to make the following script -- some time at google and some writing later, here's what I put together. It takes all the files in a given directory and converts all the BO reports into excel files (no charts though) each tab in each report is of course copied into the appropriate excel file.
Use with care..
'----------------------------------------------------------------------
dim busobj
dim strnomFichier
dim objrep
dim objExcel
dim boEditPopup
dim xlworksheet
dim strname
Dim BOApp
Dim strFilename
set BOApp= createobject("BusinessObjects.Application")
BOApp.LoginAs "USER", "PASS", False
BOApp.visible = True
Set fso=Wscript.CreateObject("Scripting.FileSystemObject")
Set f=fso.GetFolder("i:\")
Set fc=f.files
For each file in fc
strFilename = file.name
If Right(strFilename,3) = "rep" Then
Set objrep = BOApp.Documents.Open("i:\"&strFilename)
Set boEditPopup = BOApp.Application.CmdBars(2).Controls("&Edit")
Set objExcel = createobject("Excel.Application")
objExcel.Workbooks.Add
objExcel.visible = True
intreports = 1
startnumber = BOApp.ActiveDocument.reports.count
For i = startnumber To 1 Step -1
Set myrep = BOApp.ActiveDocument.reports.item(i)
myrep.activate()
boEditPopup.CmdBar.Controls("Cop&y All").Execute
Set xlWorkSheet = objExcel.Worksheets.Add()
strname = BOApp.ActiveDocument.reports.item(i).name
strname = Replace(strname, ":", "") ' Can't contain this character
strname = Replace(strname, "\", "") ' Can't contain this character
strname = Replace(strname, "/", "") ' Can't contain this character
strname = Replace(strName, "?", "") ' Can't contain this character
strname = Replace(strName, "*", "") ' Can't contain this character
strname = Replace(strName, "[", "") ' Can't contain this character
strname = Replace(strname, "]", "") ' Can't contain this character
strName = Left(strname, 31)
xlWorkSheet.Name = strname
xlWorkSheet.Paste
Set xlFormatPopup = objExcel.Application.CommandBars(1).Controls("F&ormat")
Set xlColumnPopup = xlFormatPopup.CommandBar.Controls("&Column")
xlColumnPopup.CommandBar.Controls("&AutoFit Selection").Execute
Next
End If
If Right(strFilename,3) = "rep" Then
xlWorkSheet.Saveas "i:\"&strFilename&".xls", True
End If
Next
'-----------------------------------------------------------------
Geen opmerkingen:
Een reactie posten