Option Explicit
Dim CognosID, ddeChannel As Long
Dim PowerplayReport, PowerPlay, objrep As Object
Dim ReportName, WorkBookName
Dim ReportPath, Workbookpath, Filename, MainTab, SheetName, CognosDirectory, CognosFile As String
Sub StartCognosUpdate(Filename, MainTab, SheetName, ReportName, CognosDirectory)
'This sub opens a Cognos .ppr file and saves it as an Excel file, copying all data
'and pasting it the Cognos Extract sheet as indicated by the calling sub.
'This sub checks to make sure that the directory and file are correct
'If an error occurs the subroutine will end without doing anything.
'Assign default values
CognosFile = CognosDirectory + ReportName
'Verifies existence of the file
Const lTitle = "Locating Cognos File"
If Dir(CognosFile) = "" Then
MsgBox prompt:="Can't Find " & CognosFile, Buttons:=vbExclamation, Title:=lTitle
Exit Sub
End If
Application.StatusBar = "Opening Cognos and Retrieving Lastest Cube Update"
WorkBookName = SheetName & ".xls"
ReportPath = CognosDirectory & ReportName
Workbookpath = CognosDirectory & WorkBookName
UnLockSheet (SheetName)
[b]
'Opens Cognos and saves the .ppr file as Excel
Set PowerplayReport = GetObject(ReportPath)
Set PowerPlay = PowerplayReport.Application
PowerplayReport.SaveAs Left(Workbookpath, Len(Workbookpath) - 3) & "asc", 3, True
PowerplayReport.Close
PowerPlay.Quit
Set PowerplayReport = Nothing
Set PowerPlay = Nothing
[/b]
'Clears all data from the Cognos Extract sheet and pastes in the data from the Cognos .ppr that was saved as Excel
Sheets(SheetName).Select
Cells.ClearContents
Workbooks.Open Filename:=CognosDirectory + WorkBookName
Cells.Copy
Windows(Filename).Activate
Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
LockSheet (ActiveSheet.Name)
Range("A1").Select 'deactivates selection of extract
Windows(WorkBookName).Close
Application.StatusBar = False
Kill CognosDirectory & WorkBookName
End Sub