Trapping Excel with Format Errors from Within a Macro 1

[johnoha]

Hi

I have a Macro that reads the content of a directory full of *imr's and creates Excel with Format output. The basic process works fine until there is a formatting error.

The Macro hangs on this statement..

objImpRep.ExportExcelWithFormat saveExl$

when run interactively, there would normally be a warning message dialog, asking if you wish to view the log. However, when run from Windows Scheduler the process freezes.

The log contains the following information.
1. Overlapping report object. Lower object in the report body cannot be generated. Position: 'List_Frame_1!X12' Contents: '0.00'
2. Overlapping report object. Lower object in the report body cannot be generated. Position: 'List_Frame_1!X23' Contents: '0.00'

Is there any way of trapping these errors, or ignoring the messages so that it doesn't hold up my entire reporting schedule?

Thanks in advance

 

[christenhusz]

runs without a problem with any report... what is the content of the report? and post the macro so we can look at it.

thx



christenhusz

 

[drlex]

John,
This error usually results from overlapping objects causing problems for the Excel 2002 rendering.
Best have a look at the 'PublishExcel' object and its 'ExportOptions' property so as to set the format to Excel 2000, which should avoid the error.
lex

soi la, soi carré

 

[johnoha]

Thanks drlex, this works very well. A lot more resilient.


' Save as Excel 2000
Set ImpExcelRep = objImpRep.PublishExcel
ImpExcelRep.Version 0
ImpExcelRep.ExportOptions 0

ImpExcelRep.Publish saveExl$

 

[drlex]

John,
You're welcome; thanks for the star. Here's hoping Cognos upgrade the rendering to allow exporting of > 16K rows on one sheet sometime.
lex

soi la, soi carré

 

[worldofchandran]

Hi John,

Can you post the whole macro which takes care of formatting. Am new to working with Macros and one of my clients is having similar problem of saving the report with header in Impromptu version 7.1.

Thanks

 

[johnoha]

Here it is, it does a little more than just the Excel generation.


'------------------------------------------------------
' Macro to build PowerPlay Cubes
'------------------------------------------------------
' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Global strTodaysDate As String

Dim strCatalogueDirectory1 As String
Dim strCatalogueSmallName1 As String
Dim strCatalogueFileName1 As String
Dim strCatalogueClass1 As String
Dim strCataloguePassword1 As String

Dim strDatabaseUser1 As String
Dim strDatabasePassword1 As String

' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LOG FILE DECLARE
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Global LogFile as Integer
Global ProcessFlag as Integer

Const LogFileIdentifier = "Audi-Daily-PDF-Sales_"
Const LogFilePath = "F:\IDSe42BI\Production\Macros\Logs\"

Declare Sub OpenLogFile()
Declare Sub WriteLogFile(logmsg$)
Declare Sub CloseLogFile()

' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PDF FILE DECLARE
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Declare Function convertName (n$) As String
Declare Sub SaveReportAsPDF (catname$, reportname$, catclass$, catpassword$, databaseuser$, databasepassword$, savepdf$)
Declare Sub SavePowerPlayReportAsPDF (sourceName$, destPDFName$)

'--

Declare Sub SaveReportAsExl (catname$, reportname$, catclass$, catpassword$, databaseuser$, databasepassword$, saveExl$)




Dim objImpRep as Object
Dim objImpApp as Object
Dim objPDFPub as Object
Dim objExlPub as Object

' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DEPARTMENT DECLARE
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Declare Sub ProcessDepartment (department$)

' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' COMMAND DECLARE
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type

Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type

Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long

Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As Long

Declare Function CloseHandle Lib "kernel32" (ByVal _
hObject As Long) As Long

Const NORMAL_PRIORITY_CLASS = &H20&
Const INFINITE = -1&

' Changed directory to postproduction for the Generate and Save Directory - RB 27032006

Const MacroName = "Audi-Daily-PDF-Sales.MAC"
Const CatalogueDir = "F:\IDSe42BI\Production\Audi\IDS\Hotfiles\"
Const ModelDir = "F:\IDSe42BI\Production\Audi\IDS\Powerplay Cubes\Models\"
Const TrnsDir = "C:\Program Files (x86)\Cognos\cer4\bin\"
Const PPBuildDir = "F:\IDSe42BI\Production\Audi\IDS\Powerplay Cubes\"
Const GenerateDir = "F:\IDSe42BI\Production\Audi\Generate\"
Const SaveDir = "F:\IDSe42BI\Production\Audi\"
Const DayDir = "Daily\"
Const ExclDir = "Excel\"

' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PROCESS FOLDER DOCUMENTS DECLARE
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Declare Sub FolderReportsSaveAsPDF (catname$, catclass$, catpassword$, databaseuser$, databasepassword$, sourcefolder$, destinationfolder$)
Declare Sub FolderReportsSaveAsExl (catname$, catclass$, catpassword$, databaseuser$, databasepassword$, sourcefolder$, destinationfolder$)

' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LOG FILE SUBROTINES
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'-------------------------------------------------------------------------------------
' create a log file name with the date appended to the LogFileIdentifier, ie filemmdd.LOG
'-------------------------------------------------------------------------------------

Sub OpenLogFile()

LogFile = FreeFile
Open LogFilePath & LogFileIdentifier & Format$( Now, "yymmdd_hhmm" ) & ".LOG" For Output as LogFile

End Sub

'-------------------------------------------------------------------------------------
' Write a message to the log file.
'-------------------------------------------------------------------------------------

Sub WriteLogFile(logmsg$)
Print #LogFile, Format(Now, "dmmmyy h:mm:ss") & " " & logmsg$
End Sub

'-------------------------------------------------------------------------------------
' Close the log file.
'-------------------------------------------------------------------------------------

Sub CloseLogFile()
Close LogFile
End Sub


' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PDF FILE SUBROTINES
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function replaceWildcard(strS$, strWildcard$, strNow$) As String

Dim intWildPosition As Integer
Dim intLen As Integer
Dim intRightPosition As Integer
Dim newName1 As String
Dim newName2 As String
Dim newName3 As String

intWildPosition = InStr(strS$, strWildCard$)
If intWildPosition > 0 Then
intLen = Len(strS$)
newName1 = Left(strS$ ,intWildPosition - 1)
newName2 = Format$( Now, strNow$)
intRightPosition = intLen - intWildPosition - Len(strWildcard$) + 1
If intRightPosition > 0 Then
newName3 = Right(strS$ ,intRightPosition)
Else
newName3 = ""
End If
replaceWildcard = newName1 + newName2 + NewName3
Else
replaceWildcard = strS$
End If

End Function

Function convertName(n$) As String

Dim intDatePosition As Integer
Dim intLen As Integer
Dim intRightPosition As Integer
Dim newName As String
Dim newName1 As String
Dim newName2 As String
Dim newName3 As String

' Build Parameters required to generate a PDF from a Impromptu or Powerplay Report
' Define the Report
newName = n$

newName = replaceWildcard(newName, "&YEAR", "yyyy")
newName = replaceWildcard(newName, "&MONTH", "mmmm")
newName = replaceWildcard(newName, "&DAY", "dddd")
newName = replaceWildcard(newName, "&YY", "yy")
newName = replaceWildcard(newName, "&MM", "mm")
newName = replaceWildcard(newName, "&DD", "DD")
newName = replaceWildcard(newName, "&TIMESEC", "hhmmss")
newName = replaceWildcard(newName, "&TIME", "hhmm")


' Return the new name

convertName = newName


End Function


'-------------------------------------------------------------------------------------
' Save a Impromptu Report as a PDF File
'-------------------------------------------------------------------------------------

Sub SaveReportAsPDF (catname$, reportname$, catclass$, catpassword$, databaseuser$, databasepassword$, savepdf$)

ON ERROR resume next

WriteLogFile("Save Impromptu Report as PDF")
Set objImpApp = CreateObject("CognosImpromptu.Application")

' Open the Catalogue
WriteLogFile("Open Catalogue: " + catname$)
objImpApp.OpenCatalog catname$, catclass$, catpassword$, databaseuser$, databasepassword$

' Open the Report
WriteLogFile("Open Impromptu Report: " + reportname$)
Set objImpRep = objImpApp.OpenReport(reportname$)
strReportName = objImpRep.FullName
objImpRep.RetrieveAll

' Publish the Report in PDF
Set objPDFPub = objImpRep.PublishPDF

' Save the PDF
WriteLogFile("Save as PDF File: " + savepdf$)
objPDFPub.Publish savepdf$

objImpRep.CloseReport
objImpApp.CloseCatalog
objImpApp.Quit

Set objImpApp = Nothing
Set objImpRep = Nothing
Set objPDFPub = Nothing

End Sub

'-------------------------------------------------------------------------------------
' Save a Impromptu Report as a Excel with Format File
'-------------------------------------------------------------------------------------

Sub SaveReportAsExl (catname$, reportname$, catclass$, catpassword$, databaseuser$, databasepassword$, saveExl$)

Dim strErr as String
Dim ImpExcelRep as Object

ON ERROR resume next

WriteLogFile("Save Impromptu Report as Excel with Format")
Set objImpApp = CreateObject("CognosImpromptu.Application")

objImpApp.visible 0
objImpApp.UseQueryWarnings 0

' Open the Catalogue
WriteLogFile("Open Catalogue: " + catname$)
objImpApp.OpenCatalog catname$, catclass$, catpassword$, databaseuser$, databasepassword$

' Open the Report
WriteLogFile("Open Impromptu Report: " + reportname$)
Set objImpRep = objImpApp.OpenReport(reportname$)
strReportName = objImpRep.FullName
objImpRep.RetrieveAll

'Publish the Report in Excel with Format.

' Publish and Save the PDF
WriteLogFile("Save as Excel File: " + saveExl$)

' Save as Excel 2000 (More Resilient)
Set ImpExcelRep = objImpRep.PublishExcel
ImpExcelRep.Version 0
ImpExcelRep.ExportOptions 0

ImpExcelRep.Publish saveExl$

' Old Publish Method
'''objImpRep.ExportExcelWithFormat saveExl$

objImpRep.CloseReport
objImpApp.CloseCatalog
objImpApp.Quit

Set ImpExcelRep = Nothing
Set objImpApp = Nothing
Set objImpRep = Nothing
Set objPDFPub = Nothing

End sub


'-------------------------------------------------------------------------------------
' Save a Powerplay Report as a PDF File
'-------------------------------------------------------------------------------------

sub SavePowerPlayReportAsPDF(sourceName$, destPDFName$)

Dim PPRep as Object
Dim objPDF As Object

' Open the Powerplay Cube
WriteLogFile("Save Powerplay Report as PDF")
Set PPRep = CreateObject("PowerPlay.Report")
WriteLogFile("Open Powerplay Report: " + sourceName$)
PPRep.Open sourceName$


' Define the attributes
PPRep.visible( false )
Set objPDF = pprep.PDFFile(destPDFName$, True)
With objPDF
.SaveEntireReport = True
.SaveAllCharts = True
.AxisOnAllPAges = True
.ChartTitleOnAllPages = True
' .SetListOfLayersToSave PPRep.layers.subset(1,1)
.SaveAllCharts = True
.SetListOfRowsToSave PPRep.Rows
.IncludeLegend = True
End With

' Save the PDF
WriteLogFile("Save as PDF File: " + destPDFName$)
objPDF.Save

Set objPDF = Nothing
Set PPRep = Nothing

End sub


' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' COMMAND SUBROTINES
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub ExecCmd(cmdline$)

Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO


WriteLogFile("Command Execute: " + cmdline$)

' Initialize the STARTUPINFO structure:
start.cb = Len(start)

' Start the shelled application:
ret& = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)

' Wait for the shelled application to finish:
ret& = WaitForSingleObject(proc.hProcess, INFINITE)
ret& = CloseHandle(proc.hProcess)

End Sub


' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PROCESS FOLDER DOCUMENTS SUBROTINES
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub FolderReportsSaveAsPDF(catname$, catclass$, catpassword$, databaseuser$, databasepassword$, sourcefolder$, destinationfolder$)

Dim strPFDRReportDirectory As String
Dim strPFDRReportSmallName As String
Dim strPFDRReportFileName As String

Dim strPFDRPDFDirectory As String
Dim strPFDRPDFSmallName As String
Dim strPFDRPDFFileName As String

Dim intPFDRExtensionCount as Integer
Dim strPFDRReportExtension As String

strFolder = Dir$(sourcefolder$ + "*.*")

'----Open each report file in the directory and publish as PDF
Do While StrFolder <> ""




WriteLogFile("Saving all reports in Source Folder:" + sourcefolder$ + " to PDF")

' Build Parameters required to generate a PDF from a Impromptu or Powerplay Report
' Define the Report
strPFDRReportDirectory = sourcefolder$
intPFDRExtensionCount = InStr(strFolder , ".")
strPFDRReportSmallName = Left(strFolder,intPFDRExtensionCount-1)
strPFDRReportExtension = Mid(strFolder,intPFDRExtensionCount+1, 3)
strPFDRReportFileName = strPFDRReportDirectory + strFolder

' Define the detination PDF file
strPFDRPDFDirectory = destinationfolder$
''''''strPFDRPDFSmallName = strPFDRReportSmallName + " " + ".pdf"
strPFDRPDFSmallName = strPFDRReportSmallName + ".pdf"
strPFDRPDFFileName = strPFDRPDFDirectory + strPFDRPDFSmallName

' Create and save the report as a PDF.
Select Case strPFDRReportExtension
Case "imr"
call SaveReportAsPDF( catname$, strPFDRReportFileName, catclass$, catpassword$, databaseuser$, databasepassword$, convertName(strPFDRPDFFileName))
Case "ppr"
call SavePowerPlayReportAsPDF(strPFDRReportFileName, convertName(strPFDRPDFFileName))
Case "ppx"
call SavePowerPlayReportAsPDF(strPFDRReportFileName, convertName(strPFDRPDFFileName))
Case "pyi"
' Ignore powerplay cube builds
Case Else
WriteLogFile("PDF Report not available for extension type:'" + strPFDRReportExtension + "' file:" + strFolder)
End Select

strFolder = Dir
Loop

Set PPlayRepOject = Nothing

End Sub

' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PROCESS FOLDER DOCUMENTS SUBROTINES - Excel
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub FolderReportsSaveAsExl(catname$, catclass$, catpassword$, databaseuser$, databasepassword$, sourcefolder$, destinationfolder$)

Dim strExlRReportDirectory As String
Dim strExlRReportSmallName As String
Dim strExlRReportFileName As String

Dim strExlRPDFDirectory As String
Dim strExlRPDFSmallName As String
Dim strExlRPDFFileName As String

Dim intExlRExtensionCount as Integer
Dim strExlRReportExtension As String

strFolder = Dir$(sourcefolder$ + "*.*")

'----Open each report file in the directory and publish as PDF
Do While StrFolder <> ""

WriteLogFile("Saving all reports in Source Folder:" + sourcefolder$ + " in Excel Format")

' Build Parameters required to generate a PDF from a Impromptu or Powerplay Report
' Define the Report
strExlRReportDirectory = sourcefolder$
intExlRExtensionCount = InStr(strFolder , ".")
strExlRReportSmallName = Left(strFolder,intExlRExtensionCount-1)
strExlRReportExtension = Mid(strFolder,intExlRExtensionCount+1, 3)
strExlRReportFileName = strExlRReportDirectory + strFolder

' Define the detination PDF file
strExlRPDFDirectory = destinationfolder$
strExlRPDFSmallName = strExlRReportSmallName + ".xls"
strExlRPDFFileName = strExlRPDFDirectory + strExlRPDFSmallName

' Create and save the report as a PDF.
Select Case strExlRReportExtension
Case "imr"
call SaveReportAsExl( catname$, strExlRReportFileName, catclass$, catpassword$, databaseuser$, databasepassword$, convertName(strExlRPDFFileName))
Case "ppr"
'Ignore PP reports For Excel requests
Case "ppx"
'Ignore PP reports For Excel requests
Case "pyi"
' Ignore powerplay cube builds
Case Else
WriteLogFile("Excel Report not available for extension type:'" + strExlRReportExtension + "' file:" + strFolder)
End Select

strFolder = Dir
Loop

Set PPlayRepOject = Nothing

End Sub

' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DEPARTMENT SUBROTINES
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub ProcessDepartment(department$)

WriteLogFile("Start processing department: " + department$)

' Define the source folder for reports
strSourceFolder1 = GenerateDir + department$ + "\" + DayDir

' Define the destination folder for PDF
strDesinationFolder1 = SaveDir + department$ + "\"

' Create and save the report as a PDF.
call FolderReportsSaveAsPDF(strCatalogueFileName1 , strCatalogueClass1, strCataloguePassword1 , strDatabaseUser1 , strDatabasePassword1 , strSourceFolder1 , strDesinationFolder1)


' Define the folder for reports to be saved as Excel with Formats.
strSourceFolder1 = GenerateDir + department$ + "\" + DayDir + ExclDir

' Define the destination folder for Excel for Format.
strDesinationFolder1 = SaveDir + department$ + "\"

' Create and save the report as a Excel with Format.

call FolderReportsSaveAsExl(strCatalogueFileName1 , strCatalogueClass1, strCataloguePassword1 , strDatabaseUser1 , strDatabasePassword1 , strSourceFolder1 , strDesinationFolder1)


WriteLogFile("Finished processing department:" + department$)


End Sub



' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' MAIN PROGRAM
' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Main()

' Build Parameters required to generate a PDF from a Impromptu Report
' Define the Catalogue
strCatalogueDirectory1 = CatalogueDir
strCatalogueSmallName1 = "IDSe42_AudiUAT.cat"
strCatalogueFileName1 = strCatalogueDirectory1 + strCatalogueSmallName1

' Define the Access to Catalogue
strCatalogueClass1 = "Admin"
strCataloguePassword1 = " "

' Define the Access to Database Server
strDatabaseUser1 = "IDSCOGNOS"
strDatabasePassword1 = "B1CUBE"

' Set todays global run date
strTodaysDate = date$

' Open log file for logging actions
OpenLogFile

'-------------------------------------------------------------------------------------
' SAVE FOLDER REPORTS AS PDF
'-------------------------------------------------------------------------------------

'-------------------------------------------------------------------------------------
' VEHICLES
call ProcessDepartment("Vehicles")
'------------------------------------------------------------------------------------------------------------
'Copy PDFs to Production
'------------------------------------------------------------------------------------------------------------
' ExecCmd "c:\winnt\robocopy \\srv-01\vol1\idse42bi\preproduction\ \\srv-01\vol1\idse42bi\production\ *.pdf /S /XO /log+:" + LogFilePath & LogFileIdentifier & Format$( Now, "yymmdd" ) & "R.LOG"
' WriteLogFile("Copy of PDF process complete. Please check todays log file for errors.")

WriteLogFile("The execution of " & MacroName & " has been finished")


' Close log file
CloseLogFile

End Sub

 

[worldofchandran]

Hi John,
Thank you very much for posting the macro.