xref: /aoo41x/main/migrationanalysis/src/driver_docs/DocAnalysisRunMacro.vbs (revision cdf0e10c)

'/*************************************************************************
' *
' DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
'
' Copyright 2000, 2010 Oracle and/or its affiliates.
'
' OpenOffice.org - a multi-platform office productivity suite
'
' This file is part of OpenOffice.org.
'
' OpenOffice.org is free software: you can redistribute it and/or modify
' it under the terms of the GNU Lesser General Public License version 3
' only, as published by the Free Software Foundation.
'
' OpenOffice.org is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU Lesser General Public License version 3 for more details
' (a copy is included in the LICENSE file that accompanied this code).
'
' You should have received a copy of the GNU Lesser General Public License
' version 3 along with OpenOffice.org.  If not, see
' <http://www.openoffice.org/license.html>
' for a copy of the LGPLv3 License.
'
' ************************************************************************/
'### Support Module for running macros in Word. Excel and Powerpoint
'### using automation

CONST CDA_TITLE = "Document Analysis Run Macro"
CONST CDA_ANALYSIS_INI = "analysis.ini"
Const CDA_ERR_STD_DELAY = 10
Const CDA_APPNAME_WORD = "Word"
Const CDA_APPNAME_EXCEL = "Excel"
Const CDA_APPNAME_POWERPOINT = "Powerpoint"

Dim daWrd
Dim daDoc
Dim daXl
Dim daWb
Dim daPP
Dim daPres
Dim daWshShell
Dim daFso
Dim daTitle

daTitle = CDA_TITLE

'# Setup Scripting objects
set daFso = WScript.CreateObject("Scripting.FileSystemObject")
set daWshShell = Wscript.CreateObject("Wscript.Shell")


'##### Run Macro FUNCTIONS ######

'######################
Sub DASetTitle(newTitle)
	daTitle = newTitle
End Sub

'######################
Sub DAsetupWrdServer

On Error Resume Next

Set daWrd = wscript.CreateObject("Word.Application")
If Err.Number <> 0 Then
	DAErrMsg "Failed to create Word Automation server: " & vbLf & vbLf & "Error: " _
		& CStr(Err.Number) & " " & Err.Description, CDA_ERR_STD_DELAY
	FinalExit
End If

End Sub

'######################
Sub DAOpenWrdDriver(driver)
Dim sWordDriverDocPath

On Error Resume Next
daWrd.Visible = False

'# Open a driver doc
sWordDriverDocPath = daFso.GetAbsolutePathName(driver)
'DAdiagMsg "sWordDriverDocPath : " & sWordDriverDocPath  , CDIAG_STD_DELAY

If Not daFso.FileExists(sWordDriverDocPath) Then
	DAErrMsg "Driver doc does not exist: " & sWordDriverDocPath, CDA_ERR_STD_DELAY
    	FinalExit
End If

Set daDoc = daWrd.Documents.Open(sWordDriverDocPath)
If Err.Number <> 0 Then
	DAErrMsg "Failed to open driver doc: " & vbLf & sWordDriverDocPath & vbLf & vbLf & "Error: " _
		& CStr(Err.Number) & " " & Err.Description, CDA_ERR_STD_DELAY
	FinalExit
End If

End Sub

'######################
Function DArunWrdDriver(driver, macro)

On Error Resume Next
'# Run macro
DArunWrdDriver = True
daWrd.Run ("AnalysisTool." & macro)
If Err.Number <> 0 Then
	DAErrMsg "Failed to run macro: " & macro & vbLf & vbLf & "Error: " _
		& CStr(Err.Number) & " " & Err.Description, CDA_ERR_STD_DELAY
	DArunWrdDriver = False
End If

End Function

'######################
Sub DAsaveWrdDriver(saveDriver)
'DAdiagMsg "saveDriver : " & saveDriver  , CDIAG_STD_DELAY
'DAdiagMsg "Abs(saveDriver) : " & daFso.GetAbsolutePathName( saveDriver)  , CDIAG_STD_DELAY
	daDoc.SaveAs daFso.GetAbsolutePathName( saveDriver)
End Sub

'######################
Sub DAsetupExcelServer

On Error Resume Next

Set daXl = wscript.CreateObject("Excel.Application")
If Err.Number <> 0 Then
	DAErrMsg "Failed to create Excel Automation server: " & vbLf & vbLf & "Error: " _
		& CStr(Err.Number) & " " & Err.Description, CDA_ERR_STD_DELAY
	FinalExit
End If

End Sub

'######################
Sub DAOpenExcelDriver(driver)
    Dim sExcelDriverDocPath

    On Error Resume Next
    daXl.Visible = False

    '# Open driver doc
    sExcelDriverDocPath = daFso.GetAbsolutePathName(driver)
    If Not daFso.FileExists(sExcelDriverDocPath) Then
        DAErrMsg "Driver doc does not exist: " & sExcelDriverDocPath, CDA_ERR_STD_DELAY
        FinalExit
    End If

    Set daWb = daXl.Workbooks.Open(sExcelDriverDocPath)
    If Err.Number <> 0 Then
        DAErrMsg "Failed to open driver doc: " & vbLf & sExcelDriverDocPath & vbLf & vbLf & "Error: " _
            & CStr(Err.Number) & " " & Err.Description, CDA_ERR_STD_DELAY
        FinalExit
    End If

End Sub

'######################
Function DArunExcelDriver(driver, macro)
On Error Resume Next

'# Run macro
DArunExcelDriver = True
daXl.Run ("AnalysisTool." & macro)
If Err.Number <> 0 Then
	DAErrMsg "Failed to run macro: " & macro & vbLf & vbLf & "Error: " _
		& CStr(Err.Number) & " " & Err.Description, CDA_ERR_STD_DELAY
	DArunExcelDriver = False
End If

End Function

'######################
Sub DAsaveExcelDriver(saveDriver)
	'# Not overwritting - Excel hangs, need to remove file first
	if daFso.FileExists(daFso.GetAbsolutePathName(saveDriver)) Then
		daFso.DeleteFile(daFso.GetAbsolutePathName(saveDriver))
	End If
	daWb.SaveAs daFso.GetAbsolutePathName(saveDriver)
End Sub

'######################
Sub DAsetupPPServer

On Error Resume Next

Set daPP = wscript.CreateObject("PowerPoint.Application")
If Err.Number <> 0 Then
	DAErrMsg "Failed to create PowerPoint Automation server: " & vbLf & vbLf & "Error: " _
		& CStr(Err.Number) & " " & Err.Description, CDA_ERR_STD_DELAY
	FinalExit
End If

End Sub

'######################
Sub DAOpenPPDriver(driver)
Dim sPPDriverDocPath

On Error Resume Next


'# Open driver doc
sPPDriverDocPath = daFso.GetAbsolutePathName(driver)
If Not daFso.FileExists(sPPDriverDocPath ) Then
	DAErrMsg "Driver doc does not exist: " & sPPDriverDocPath, CDA_ERR_STD_DELAY
    	FinalExit
End If


'## MS: KB Article 155073 ##
'# PPT7: OLE Automation Error Using Open Method
'# MUST show the PowerPoint application window at least once before calling the Application.Presentations.Open method
daPP.Visible = True
daPP.WindowState = 2 'Minimize PowerPoint

daPP.Presentations.Open sPPDriverDocPath
If Err.Number <> 0 Then
	DAErrMsg "Failed to open driver doc: " & vbLf & sPPDriverDocPath & vbLf & vbLf & "Error: " _
		& CStr(Err.Number) & " " & Err.Description, CDA_ERR_STD_DELAY
	FinalExit
End If

set daPres = daPP.Presentations(1)

End Sub

'######################
Function DArunPPDriver(driver, macro)

On Error Resume Next
'# Run macro
DArunPPDriver = True
daPP.Run (daFso.GetFileName(driver) & "!" & macro)
If Err.Number <> 0 Then
	DAErrMsg "Failed to run macro: " & macro & vbLf & vbLf & "Error: " _
		& CStr(Err.Number) & " " & Err.Description, CDA_ERR_STD_DELAY
	DArunPPDriver = False
End If

End Function

'######################
Sub DAsavePPDriver(saveDriver)
	daPres.SaveAs daFso.GetAbsolutePathName(saveDriver)
End Sub


'######################

Sub DACloseApps()
    '# Quit apps
    On Error Resume Next
    If Not daWrd Is Nothing Then
        daDoc.Close wdDoNotSaveChanges
        daWrd.Quit
    End If
    If Not daXl Is Nothing Then
        daWb.Close False
        daXl.Quit
    End If
    If Not daPP Is Nothing Then
        daPres.Close
        daPP.Quit
    End If

    Set daDoc = Nothing
    Set daWb = Nothing
    Set daPres = Nothing

    Set daWrd = Nothing
    Set daXl = Nothing
    Set daPP = Nothing
End Sub

'######################

Sub DACleanUp()
    '# Quit apps
    On Error Resume Next

    DACloseApps

    Set daFso = Nothing
    Set daWshShell = Nothing
End Sub


'######################
Sub DAdiagMsg( msg, delay)
	'# WSHShell.echo: Popup if run with Wscript.exe, command line output if run with Cscript.exe
	WScript.Echo msg

	'WSHShell.popup msg, delay, daTitle, 64
End Sub

'######################
Sub DAErrMsg( msg, delay)
	daWshShell.Popup msg, delay, daTitle, 16

	'WScript.Echo msg
End Sub

'######################
Sub DAVerifyAnalysisIni()
	if daFso.FileExists(daFso.GetAbsolutePathName(".\" & CDA_ANALYSIS_INI)) Then Exit Sub

	DAErrMsg CDA_ANALYSIS_INI & " does not exist. " & vbLf & vbLf & _
		"You need to create it manually or use the DocAnalysisWizard to create one for you." & vbLf & _
		"Once this is done you can rerun the Document Analysis command line.", CDA_ERR_STD_DELAY
    	FinalExit
End Sub

'######################
Sub DAExportFile(fileName, projectFile, app_name)
    On Error Resume Next

    Dim myProject

    '# Setup App Specifc VB Project
    Set myProject = DAgetProject(fileName, projectFile, app_name)

    Dim myComponent
    Set myComponent = myProject.VBComponents(projectFile)
    If Err.Number <> 0 Then
	DAErrMsg "Missing Project File [" & projectFile & "] - Path:" & vbLf & vbLf & fileName, CERR_STD_DELAY
    	Set myComponent = Nothing
	Set myProject = Nothing
	FinalExit
    End If

    myProject.VBComponents(projectFile).Export fileName
    If Err.Number <> 0 Then
	DAErrMsg "Error exporting Project File [" & projectFile & "] - Path:" & vbLf & vbLf & fileName, CERR_STD_DELAY
    	Set myComponent = Nothing
	Set myProject = Nothing
	FinalExit
    End If

    Set myComponent = Nothing
    Set myProject = Nothing

End Sub

'######################
Sub DAImportFile(fileName, projectFile, app_name)
    On Error Resume Next

    Dim myProject

    '# Setup App Specifc VB Project
    Set myProject = DAgetProject(fileName, projectFile, app_name)

    '# Check if module already exists raise error
    Dim myComponent
    Set myComponent = myProject.VBComponents(projectFile)
    If Err.Number = 0 Then
        DAErrMsg "Duplicate Project File [" & projectFile & "] - Path:" & vbLf & vbLf & fileName, CERR_STD_DELAY
        Set myComponent = Nothing
        Set myProject = Nothing
        FinalExit
    End If

    '#If module not there need to clear out of index error
    Err.Clear

    If Not daFso.FileExists(fileName) Then
        DAErrMsg "Missing File " & fileName, CERR_STD_DELAY
        Set myComponent = Nothing
        Set myProject = Nothing
        FinalExit
    End If

    Call myProject.VBComponents.Import(fileName)

    If Err.Number <> 0 Then
        DAErrMsg "Error importing Project File [" & projectFile & "] - Path:" & vbLf & vbLf & fileName, CERR_STD_DELAY
    	Set myComponent = Nothing
        Set myProject = Nothing
        FinalExit
    End If

    Set myComponent = Nothing
    Set myProject = Nothing
End Sub

'#################

Sub DARemoveModule(fileName, projectFile, app_name)
     On Error Resume Next

    Dim myProject

    '# Setup App Specifc VB Project
    Set myProject = DAgetProject(fileName, projectFile, app_name)

    '# Check if module already exists raise error
    Dim myComponent
    Set myComponent = myProject.VBComponents(projectFile)


    myProject.VBComponents.Remove myComponent

    If Err.Number <> 0 Then
	DAErrMsg "Error removing Project File [" & projectFile & "] - Path:" & vbLf & vbLf & fileName, CERR_STD_DELAY
    	Set myComponent = Nothing
	Set myProject = Nothing
	FinalExit
    End If

    Set myComponent = Nothing
    Set myProject = Nothing
End Sub

'######################
Function DAgetProject(fileName, projectFile, app_name)
    On Error Resume Next

    If app_name = CDA_APPNAME_WORD Then
	Set DAgetProject = daWrd.ActiveDocument.VBProject

    ElseIf app_name = CDA_APPNAME_EXCEL Then
	Set DAgetProject = daXl.ActiveWorkbook.VBProject

    ElseIf app_name = CDA_APPNAME_POWERPOINT Then
	Set DAgetProject = daPP.ActivePresentation.VBProject
    End If

    If Err.Number <> 0 Then
	DAErrMsg "Cannot access VBProject for Project File [" & projectFile & "] - Path:" & vbLf & vbLf & fileName, _
		CERR_STD_DELAY
	Set DAgetProject = Nothing
	FinalExit
    End If

End Function