summaryrefslogtreecommitdiff
path: root/migrationanalysis/src/driver_docs/DocAnalysisRunMacro.vbs
diff options
context:
space:
mode:
Diffstat (limited to 'migrationanalysis/src/driver_docs/DocAnalysisRunMacro.vbs')
-rw-r--r--migrationanalysis/src/driver_docs/DocAnalysisRunMacro.vbs438
1 files changed, 438 insertions, 0 deletions
diff --git a/migrationanalysis/src/driver_docs/DocAnalysisRunMacro.vbs b/migrationanalysis/src/driver_docs/DocAnalysisRunMacro.vbs
new file mode 100644
index 000000000000..4fa6b203ae4a
--- /dev/null
+++ b/migrationanalysis/src/driver_docs/DocAnalysisRunMacro.vbs
@@ -0,0 +1,438 @@
+'/*************************************************************************
+' *
+' 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
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-04-19 21:28:11 +0000