path: root/migrationanalysis/src/driver_docs/DocAnalysisRunMacro.vbs

'/*************************************************************************
' *
' * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
' * 
' * Copyright 2008 by Sun Microsystems, Inc.
' *
' * OpenOffice.org - a multi-platform office productivity suite
' *
' * $RCSfile: DocAnalysisRunMacro.vbs,v $
' * $Revision: 1.2.140.1 $
' *
' * 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