migrationanalysis/src/driver_docs/DocAnalysisRunMacro.vbs

   1 '/*************************************************************************
   2 ' *
   3 ' * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
   4 ' *
   5 ' * Copyright 2008 by Sun Microsystems, Inc.
   6 ' *
   7 ' * OpenOffice.org - a multi-platform office productivity suite
   8 ' *
   9 ' * $RCSfile: DocAnalysisRunMacro.vbs,v $
  10 ' * $Revision: 1.2.140.1 $
  11 ' *
  12 ' * This file is part of OpenOffice.org.
  13 ' *
  14 ' * OpenOffice.org is free software: you can redistribute it and/or modify
  15 ' * it under the terms of the GNU Lesser General Public License version 3
  16 ' * only, as published by the Free Software Foundation.
  17 ' *
  18 ' * OpenOffice.org is distributed in the hope that it will be useful,
  19 ' * but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ' * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ' * GNU Lesser General Public License version 3 for more details
  22 ' * (a copy is included in the LICENSE file that accompanied this code).
  23 ' *
  24 ' * You should have received a copy of the GNU Lesser General Public License
  25 ' * version 3 along with OpenOffice.org.  If not, see
  26 ' * <http://www.openoffice.org/license.html>
  27 ' * for a copy of the LGPLv3 License.
  28 ' *
  29 ' ************************************************************************/
  30 '### Support Module for running macros in Word. Excel and Powerpoint
  31 '### using automation
  32
  33 CONST CDA_TITLE = "Document Analysis Run Macro"
  34 CONST CDA_ANALYSIS_INI = "analysis.ini"
  35 Const CDA_ERR_STD_DELAY = 10
  36 Const CDA_APPNAME_WORD = "Word"
  37 Const CDA_APPNAME_EXCEL = "Excel"
  38 Const CDA_APPNAME_POWERPOINT = "Powerpoint"
  39
  40 Dim daWrd
  41 Dim daDoc
  42 Dim daXl
  43 Dim daWb
  44 Dim daPP
  45 Dim daPres
  46 Dim daWshShell
  47 Dim daFso
  48 Dim daTitle
  49
  50 daTitle = CDA_TITLE
  51
  52 '# Setup Scripting objects
  53 set daFso = WScript.CreateObject("Scripting.FileSystemObject")
  54 set daWshShell = Wscript.CreateObject("Wscript.Shell")
  55
  56
  57 '##### Run Macro FUNCTIONS ######
  58
  59 '######################
  60 Sub DASetTitle(newTitle)
  61         daTitle = newTitle
  62 End Sub
  63
  64 '######################
  65 Sub DAsetupWrdServer
  66
  67 On Error Resume Next
  68
  69 Set daWrd = wscript.CreateObject("Word.Application")
  70 If Err.Number <> 0 Then
  71         DAErrMsg "Failed to create Word Automation server: " & vbLf & vbLf & "Error: " _
  72                 & CStr(Err.Number) & " " & Err.Description, CDA_ERR_STD_DELAY
  73         FinalExit
  74 End If
  75
  76 End Sub
  77
  78 '######################
  79 Sub DAOpenWrdDriver(driver)
  80 Dim sWordDriverDocPath
  81
  82 On Error Resume Next
  83 daWrd.Visible = False
  84
  85 '# Open a driver doc
  86 sWordDriverDocPath = daFso.GetAbsolutePathName(driver)
  87 'DAdiagMsg "sWordDriverDocPath : " & sWordDriverDocPath  , CDIAG_STD_DELAY
  88
  89 If Not daFso.FileExists(sWordDriverDocPath) Then
  90         DAErrMsg "Driver doc does not exist: " & sWordDriverDocPath, CDA_ERR_STD_DELAY
  91         FinalExit
  92 End If
  93
  94 Set daDoc = daWrd.Documents.Open(sWordDriverDocPath)
  95 If Err.Number <> 0 Then
  96         DAErrMsg "Failed to open driver doc: " & vbLf & sWordDriverDocPath & vbLf & vbLf & "Error: " _
  97                 & CStr(Err.Number) & " " & Err.Description, CDA_ERR_STD_DELAY
  98         FinalExit
  99 End If
 100
 101 End Sub
 102
 103 '######################
 104 Function DArunWrdDriver(driver, macro)
 105
 106 On Error Resume Next
 107 '# Run macro
 108 DArunWrdDriver = True
 109 daWrd.Run ("AnalysisTool." & macro)
 110 If Err.Number <> 0 Then
 111         DAErrMsg "Failed to run macro: " & macro & vbLf & vbLf & "Error: " _
 112                 & CStr(Err.Number) & " " & Err.Description, CDA_ERR_STD_DELAY
 113         DArunWrdDriver = False
 114 End If
 115
 116 End Function
 117
 118 '######################
 119 Sub DAsaveWrdDriver(saveDriver)
 120 'DAdiagMsg "saveDriver : " & saveDriver  , CDIAG_STD_DELAY
 121 'DAdiagMsg "Abs(saveDriver) : " & daFso.GetAbsolutePathName( saveDriver)  , CDIAG_STD_DELAY
 122         daDoc.SaveAs daFso.GetAbsolutePathName( saveDriver)
 123 End Sub
 124
 125 '######################
 126 Sub DAsetupExcelServer
 127
 128 On Error Resume Next
 129
 130 Set daXl = wscript.CreateObject("Excel.Application")
 131 If Err.Number <> 0 Then
 132         DAErrMsg "Failed to create Excel Automation server: " & vbLf & vbLf & "Error: " _
 133                 & CStr(Err.Number) & " " & Err.Description, CDA_ERR_STD_DELAY
 134         FinalExit
 135 End If
 136
 137 End Sub
 138
 139 '######################
 140 Sub DAOpenExcelDriver(driver)
 141     Dim sExcelDriverDocPath
 142
 143     On Error Resume Next
 144     daXl.Visible = False
 145
 146     '# Open driver doc
 147     sExcelDriverDocPath = daFso.GetAbsolutePathName(driver)
 148     If Not daFso.FileExists(sExcelDriverDocPath) Then
 149         DAErrMsg "Driver doc does not exist: " & sExcelDriverDocPath, CDA_ERR_STD_DELAY
 150         FinalExit
 151     End If
 152
 153     Set daWb = daXl.Workbooks.Open(sExcelDriverDocPath)
 154     If Err.Number <> 0 Then
 155         DAErrMsg "Failed to open driver doc: " & vbLf & sExcelDriverDocPath & vbLf & vbLf & "Error: " _
 156             & CStr(Err.Number) & " " & Err.Description, CDA_ERR_STD_DELAY
 157         FinalExit
 158     End If
 159
 160 End Sub
 161
 162 '######################
 163 Function DArunExcelDriver(driver, macro)
 164 On Error Resume Next
 165
 166 '# Run macro
 167 DArunExcelDriver = True
 168 daXl.Run ("AnalysisTool." & macro)
 169 If Err.Number <> 0 Then
 170         DAErrMsg "Failed to run macro: " & macro & vbLf & vbLf & "Error: " _
 171                 & CStr(Err.Number) & " " & Err.Description, CDA_ERR_STD_DELAY
 172         DArunExcelDriver = False
 173 End If
 174
 175 End Function
 176
 177 '######################
 178 Sub DAsaveExcelDriver(saveDriver)
 179         '# Not overwritting - Excel hangs, need to remove file first
 180         if daFso.FileExists(daFso.GetAbsolutePathName(saveDriver)) Then
 181                 daFso.DeleteFile(daFso.GetAbsolutePathName(saveDriver))
 182         End If
 183         daWb.SaveAs daFso.GetAbsolutePathName(saveDriver)
 184 End Sub
 185
 186 '######################
 187 Sub DAsetupPPServer
 188
 189 On Error Resume Next
 190
 191 Set daPP = wscript.CreateObject("PowerPoint.Application")
 192 If Err.Number <> 0 Then
 193         DAErrMsg "Failed to create PowerPoint Automation server: " & vbLf & vbLf & "Error: " _
 194                 & CStr(Err.Number) & " " & Err.Description, CDA_ERR_STD_DELAY
 195         FinalExit
 196 End If
 197
 198 End Sub
 199
 200 '######################
 201 Sub DAOpenPPDriver(driver)
 202 Dim sPPDriverDocPath
 203
 204 On Error Resume Next
 205
 206
 207 '# Open driver doc
 208 sPPDriverDocPath = daFso.GetAbsolutePathName(driver)
 209 If Not daFso.FileExists(sPPDriverDocPath ) Then
 210         DAErrMsg "Driver doc does not exist: " & sPPDriverDocPath, CDA_ERR_STD_DELAY
 211         FinalExit
 212 End If
 213
 214
 215 '## MS: KB Article 155073 ##
 216 '# PPT7: OLE Automation Error Using Open Method
 217 '# MUST show the PowerPoint application window at least once before calling the Application.Presentations.Open method
 218 daPP.Visible = True
 219 daPP.WindowState = 2 'Minimize PowerPoint
 220
 221 daPP.Presentations.Open sPPDriverDocPath
 222 If Err.Number <> 0 Then
 223         DAErrMsg "Failed to open driver doc: " & vbLf & sPPDriverDocPath & vbLf & vbLf & "Error: " _
 224                 & CStr(Err.Number) & " " & Err.Description, CDA_ERR_STD_DELAY
 225         FinalExit
 226 End If
 227
 228 set daPres = daPP.Presentations(1)
 229
 230 End Sub
 231
 232 '######################
 233 Function DArunPPDriver(driver, macro)
 234
 235 On Error Resume Next
 236 '# Run macro
 237 DArunPPDriver = True
 238 daPP.Run (daFso.GetFileName(driver) & "!" & macro)
 239 If Err.Number <> 0 Then
 240         DAErrMsg "Failed to run macro: " & macro & vbLf & vbLf & "Error: " _
 241                 & CStr(Err.Number) & " " & Err.Description, CDA_ERR_STD_DELAY
 242         DArunPPDriver = False
 243 End If
 244
 245 End Function
 246
 247 '######################
 248 Sub DAsavePPDriver(saveDriver)
 249         daPres.SaveAs daFso.GetAbsolutePathName(saveDriver)
 250 End Sub
 251
 252
 253 '######################
 254
 255 Sub DACloseApps()
 256     '# Quit apps
 257     On Error Resume Next
 258     If Not daWrd Is Nothing Then
 259         daDoc.Close wdDoNotSaveChanges
 260         daWrd.Quit
 261     End If
 262     If Not daXl Is Nothing Then
 263         daWb.Close False
 264         daXl.Quit
 265     End If
 266     If Not daPP Is Nothing Then
 267         daPres.Close
 268         daPP.Quit
 269     End If
 270
 271     Set daDoc = Nothing
 272     Set daWb = Nothing
 273     Set daPres = Nothing
 274
 275     Set daWrd = Nothing
 276     Set daXl = Nothing
 277     Set daPP = Nothing
 278 End Sub
 279
 280 '######################
 281
 282 Sub DACleanUp()
 283     '# Quit apps
 284     On Error Resume Next
 285
 286     DACloseApps
 287
 288     Set daFso = Nothing
 289     Set daWshShell = Nothing
 290 End Sub
 291
 292
 293 '######################
 294 Sub DAdiagMsg( msg, delay)
 295         '# WSHShell.echo: Popup if run with Wscript.exe, command line output if run with Cscript.exe
 296         WScript.Echo msg
 297
 298         'WSHShell.popup msg, delay, daTitle, 64
 299 End Sub
 300
 301 '######################
 302 Sub DAErrMsg( msg, delay)
 303         daWshShell.Popup msg, delay, daTitle, 16
 304
 305         'WScript.Echo msg
 306 End Sub
 307
 308 '######################
 309 Sub DAVerifyAnalysisIni()
 310         if daFso.FileExists(daFso.GetAbsolutePathName(".\" & CDA_ANALYSIS_INI)) Then Exit Sub
 311
 312         DAErrMsg CDA_ANALYSIS_INI & " does not exist. " & vbLf & vbLf & _
 313                 "You need to create it manually or use the DocAnalysisWizard to create one for you." & vbLf & _
 314                 "Once this is done you can rerun the Document Analysis command line.", CDA_ERR_STD_DELAY
 315         FinalExit
 316 End Sub
 317
 318 '######################
 319 Sub DAExportFile(fileName, projectFile, app_name)
 320     On Error Resume Next
 321
 322     Dim myProject
 323
 324     '# Setup App Specifc VB Project
 325     Set myProject = DAgetProject(fileName, projectFile, app_name)
 326
 327     Dim myComponent
 328     Set myComponent = myProject.VBComponents(projectFile)
 329     If Err.Number <> 0 Then
 330         DAErrMsg "Missing Project File [" & projectFile & "] - Path:" & vbLf & vbLf & fileName, CERR_STD_DELAY
 331         Set myComponent = Nothing
 332         Set myProject = Nothing
 333         FinalExit
 334     End If
 335
 336     myProject.VBComponents(projectFile).Export fileName
 337     If Err.Number <> 0 Then
 338         DAErrMsg "Error exporting Project File [" & projectFile & "] - Path:" & vbLf & vbLf & fileName, CERR_STD_DELAY
 339         Set myComponent = Nothing
 340         Set myProject = Nothing
 341         FinalExit
 342     End If
 343
 344     Set myComponent = Nothing
 345     Set myProject = Nothing
 346
 347 End Sub
 348
 349 '######################
 350 Sub DAImportFile(fileName, projectFile, app_name)
 351     On Error Resume Next
 352
 353     Dim myProject
 354
 355     '# Setup App Specifc VB Project
 356     Set myProject = DAgetProject(fileName, projectFile, app_name)
 357
 358     '# Check if module already exists raise error
 359     Dim myComponent
 360     Set myComponent = myProject.VBComponents(projectFile)
 361     If Err.Number = 0 Then
 362         DAErrMsg "Duplicate Project File [" & projectFile & "] - Path:" & vbLf & vbLf & fileName, CERR_STD_DELAY
 363         Set myComponent = Nothing
 364         Set myProject = Nothing
 365         FinalExit
 366     End If
 367
 368     '#If module not there need to clear out of index error
 369     Err.Clear
 370
 371     If Not daFso.FileExists(fileName) Then
 372         DAErrMsg "Missing File " & fileName, CERR_STD_DELAY
 373         Set myComponent = Nothing
 374         Set myProject = Nothing
 375         FinalExit
 376     End If
 377
 378     Call myProject.VBComponents.Import(fileName)
 379
 380     If Err.Number <> 0 Then
 381         DAErrMsg "Error importing Project File [" & projectFile & "] - Path:" & vbLf & vbLf & fileName, CERR_STD_DELAY
 382         Set myComponent = Nothing
 383         Set myProject = Nothing
 384         FinalExit
 385     End If
 386
 387     Set myComponent = Nothing
 388     Set myProject = Nothing
 389 End Sub
 390
 391 '#################
 392
 393 Sub DARemoveModule(fileName, projectFile, app_name)
 394      On Error Resume Next
 395
 396     Dim myProject
 397
 398     '# Setup App Specifc VB Project
 399     Set myProject = DAgetProject(fileName, projectFile, app_name)
 400
 401     '# Check if module already exists raise error
 402     Dim myComponent
 403     Set myComponent = myProject.VBComponents(projectFile)
 404
 405
 406     myProject.VBComponents.Remove myComponent
 407
 408     If Err.Number <> 0 Then
 409         DAErrMsg "Error removing Project File [" & projectFile & "] - Path:" & vbLf & vbLf & fileName, CERR_STD_DELAY
 410         Set myComponent = Nothing
 411         Set myProject = Nothing
 412         FinalExit
 413     End If
 414
 415     Set myComponent = Nothing
 416     Set myProject = Nothing
 417 End Sub
 418
 419 '######################
 420 Function DAgetProject(fileName, projectFile, app_name)
 421     On Error Resume Next
 422
 423     If app_name = CDA_APPNAME_WORD Then
 424         Set DAgetProject = daWrd.ActiveDocument.VBProject
 425
 426     ElseIf app_name = CDA_APPNAME_EXCEL Then
 427         Set DAgetProject = daXl.ActiveWorkbook.VBProject
 428
 429     ElseIf app_name = CDA_APPNAME_POWERPOINT Then
 430         Set DAgetProject = daPP.ActivePresentation.VBProject
 431     End If
 432
 433     If Err.Number <> 0 Then
 434         DAErrMsg "Cannot access VBProject for Project File [" & projectFile & "] - Path:" & vbLf & vbLf & fileName, _
 435                 CERR_STD_DELAY
 436         Set DAgetProject = Nothing
 437         FinalExit
 438     End If
 439
 440 End Function
 441