You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@openoffice.apache.org by ms...@apache.org on 2025/09/06 17:20:52 UTC
(openoffice) branch AOO42X updated: pre-commit auto whitespace clean up for `bas` files (#417)
This is an automated email from the ASF dual-hosted git repository.
mseidel pushed a commit to branch AOO42X
in repository https://gitbox.apache.org/repos/asf/openoffice.git
The following commit(s) were added to refs/heads/AOO42X by this push:
new 2823505da2 pre-commit auto whitespace clean up for `bas` files (#417)
2823505da2 is described below
commit 2823505da2c122121568c8f40f2e319a42426ed8
Author: John Bampton <jb...@users.noreply.github.com>
AuthorDate: Sun Sep 7 03:14:35 2025 +1000
pre-commit auto whitespace clean up for `bas` files (#417)
Enforced two hooks for `bas` files:
- end-of-file-fixer
- trailing-whitespace
(cherry picked from commit b28244b6bc64214f0fd1382e7ca3061cf7b36a40)
---
main/basic/source/sample/sample.bas | 28 +-
.../test/ole/DCOM/Clients/WriterDemo/Module1.bas | 8 +-
.../extensions/test/ole/DCOM/dcom_test/Module1.bas | 8 +-
.../VBEventListener/Module1.bas | 12 +-
.../test/ole/StarBasic_OleClient/oleclient.bas | 44 +-
main/framework/test/test_componentenumeration.bas | 20 +-
main/framework/test/test_documentproperties.bas | 12 +-
main/framework/test/test_filterregistration.bas | 8 +-
.../framework/test/test_statusindicatorfactory.bas | 8 +-
.../src/driver_docs/sources/AnalysisDriver.bas | 720 ++++++++++-----------
.../sources/CommonMigrationAnalyser.bas | 229 ++++---
.../src/driver_docs/sources/CommonPreparation.bas | 55 +-
.../src/driver_docs/sources/LocalizeResults.bas | 8 +-
.../src/driver_docs/sources/common_res.bas | 5 +-
.../sources/excel/ApplicationSpecific.bas | 13 +-
.../src/driver_docs/sources/excel/Preparation.bas | 8 +-
.../driver_docs/sources/excel/SetTextBoxFont.bas | 5 +-
.../src/driver_docs/sources/excel/excel_res.bas | 5 +-
.../sources/powerpoint/ApplicationSpecific.bas | 8 +-
.../src/driver_docs/sources/powerpoint/Loader.bas | 6 +-
.../driver_docs/sources/powerpoint/Preparation.bas | 5 +-
.../sources/powerpoint/powerpoint_res.bas | 6 +-
.../src/driver_docs/sources/results_res.bas | 8 +-
.../sources/word/ApplicationSpecific.bas | 9 +-
.../src/driver_docs/sources/word/Preparation.bas | 28 +-
.../src/driver_docs/sources/word/word_res.bas | 7 +-
main/migrationanalysis/src/wizard/Analyse.bas | 30 +-
.../src/wizard/Get Directory Dialog.bas | 22 +-
main/migrationanalysis/src/wizard/IniSupport.bas | 63 +-
.../src/wizard/Office10Issues.bas | 56 +-
main/migrationanalysis/src/wizard/RunServer.bas | 11 +-
main/migrationanalysis/src/wizard/Utilities.bas | 109 ++--
main/migrationanalysis/src/wizard/Wizard.bas | 79 ++-
33 files changed, 796 insertions(+), 847 deletions(-)
diff --git a/main/basic/source/sample/sample.bas b/main/basic/source/sample/sample.bas
index b2df5ebd64..7419af3e47 100644
--- a/main/basic/source/sample/sample.bas
+++ b/main/basic/source/sample/sample.bas
@@ -1,5 +1,5 @@
rem *************************************************************
-rem
+rem
rem Licensed to the Apache Software Foundation (ASF) under one
rem or more contributor license agreements. See the NOTICE file
rem distributed with this work for additional information
@@ -7,16 +7,16 @@ rem regarding copyright ownership. The ASF licenses this file
rem to you under the Apache License, Version 2.0 (the
rem "License"); you may not use this file except in compliance
rem with the License. You may obtain a copy of the License at
-rem
+rem
rem http://www.apache.org/licenses/LICENSE-2.0
-rem
+rem
rem Unless required by applicable law or agreed to in writing,
rem software distributed under the License is distributed on an
rem "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
rem KIND, either express or implied. See the License for the
rem specific language governing permissions and limitations
rem under the License.
-rem
+rem
rem *************************************************************
' Sample-Programm fuer Sample-Objekte
@@ -37,23 +37,3 @@ End Sub
Sub Bang
print "Sample-Callback: BANG!"
End Sub
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/main/extensions/test/ole/DCOM/Clients/WriterDemo/Module1.bas b/main/extensions/test/ole/DCOM/Clients/WriterDemo/Module1.bas
index 4480e7a8f7..a1072f220a 100644
--- a/main/extensions/test/ole/DCOM/Clients/WriterDemo/Module1.bas
+++ b/main/extensions/test/ole/DCOM/Clients/WriterDemo/Module1.bas
@@ -1,5 +1,5 @@
rem *************************************************************
-rem
+rem
rem Licensed to the Apache Software Foundation (ASF) under one
rem or more contributor license agreements. See the NOTICE file
rem distributed with this work for additional information
@@ -7,16 +7,16 @@ rem regarding copyright ownership. The ASF licenses this file
rem to you under the Apache License, Version 2.0 (the
rem "License"); you may not use this file except in compliance
rem with the License. You may obtain a copy of the License at
-rem
+rem
rem http://www.apache.org/licenses/LICENSE-2.0
-rem
+rem
rem Unless required by applicable law or agreed to in writing,
rem software distributed under the License is distributed on an
rem "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
rem KIND, either express or implied. See the License for the
rem specific language governing permissions and limitations
rem under the License.
-rem
+rem
rem *************************************************************
Attribute VB_Name = "Module1"
Option Explicit
diff --git a/main/extensions/test/ole/DCOM/dcom_test/Module1.bas b/main/extensions/test/ole/DCOM/dcom_test/Module1.bas
index 3f50ed88da..7ebecf0ca8 100644
--- a/main/extensions/test/ole/DCOM/dcom_test/Module1.bas
+++ b/main/extensions/test/ole/DCOM/dcom_test/Module1.bas
@@ -1,5 +1,5 @@
rem *************************************************************
-rem
+rem
rem Licensed to the Apache Software Foundation (ASF) under one
rem or more contributor license agreements. See the NOTICE file
rem distributed with this work for additional information
@@ -7,16 +7,16 @@ rem regarding copyright ownership. The ASF licenses this file
rem to you under the Apache License, Version 2.0 (the
rem "License"); you may not use this file except in compliance
rem with the License. You may obtain a copy of the License at
-rem
+rem
rem http://www.apache.org/licenses/LICENSE-2.0
-rem
+rem
rem Unless required by applicable law or agreed to in writing,
rem software distributed under the License is distributed on an
rem "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
rem KIND, either express or implied. See the License for the
rem specific language governing permissions and limitations
rem under the License.
-rem
+rem
rem *************************************************************
Attribute VB_Name = "Module1"
Option Explicit
diff --git a/main/extensions/test/ole/EventListenerSample/VBEventListener/Module1.bas b/main/extensions/test/ole/EventListenerSample/VBEventListener/Module1.bas
index 82c90d2362..a03b4e60b9 100644
--- a/main/extensions/test/ole/EventListenerSample/VBEventListener/Module1.bas
+++ b/main/extensions/test/ole/EventListenerSample/VBEventListener/Module1.bas
@@ -1,5 +1,5 @@
rem *************************************************************
-rem
+rem
rem Licensed to the Apache Software Foundation (ASF) under one
rem or more contributor license agreements. See the NOTICE file
rem distributed with this work for additional information
@@ -7,23 +7,21 @@ rem regarding copyright ownership. The ASF licenses this file
rem to you under the Apache License, Version 2.0 (the
rem "License"); you may not use this file except in compliance
rem with the License. You may obtain a copy of the License at
-rem
+rem
rem http://www.apache.org/licenses/LICENSE-2.0
-rem
+rem
rem Unless required by applicable law or agreed to in writing,
rem software distributed under the License is distributed on an
rem "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
rem KIND, either express or implied. See the License for the
rem specific language governing permissions and limitations
rem under the License.
-rem
+rem
rem *************************************************************
Attribute VB_Name = "Module1"
Option Explicit
Sub Main()
-
-End Sub
-
+End Sub
diff --git a/main/extensions/test/ole/StarBasic_OleClient/oleclient.bas b/main/extensions/test/ole/StarBasic_OleClient/oleclient.bas
index 41fe415fed..5919575896 100644
--- a/main/extensions/test/ole/StarBasic_OleClient/oleclient.bas
+++ b/main/extensions/test/ole/StarBasic_OleClient/oleclient.bas
@@ -1,5 +1,5 @@
rem *************************************************************
-rem
+rem
rem Licensed to the Apache Software Foundation (ASF) under one
rem or more contributor license agreements. See the NOTICE file
rem distributed with this work for additional information
@@ -7,16 +7,16 @@ rem regarding copyright ownership. The ASF licenses this file
rem to you under the Apache License, Version 2.0 (the
rem "License"); you may not use this file except in compliance
rem with the License. You may obtain a copy of the License at
-rem
+rem
rem http://www.apache.org/licenses/LICENSE-2.0
-rem
+rem
rem Unless required by applicable law or agreed to in writing,
rem software distributed under the License is distributed on an
rem "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
rem KIND, either express or implied. See the License for the
rem specific language governing permissions and limitations
rem under the License.
-rem
+rem
rem *************************************************************
REM ***** BASIC *****
@@ -25,22 +25,22 @@ OPTION EXPLICIT
OPTION COMPATIBLE
Sub Main
-COMPATIBILITYMODE(true)
+COMPATIBILITYMODE(true)
If runtest = -1 Then
MsgBox "Test Failed!!!"
-Else
+Else
MsgBox "Test Succeeded"
End If
End Sub
Function runtest() As Integer
-Dim inBool As Boolean, inBool2 As Boolean, outBool As Boolean
+Dim inBool As Boolean, inBool2 As Boolean, outBool As Boolean
Dim inByte As Integer, inByte2 As Integer
Dim inShort As Integer, inShort2 As Integer
Dim inLong As Long, inLong2 As Long, inLong3 As Long, inLong4 As Long
-Dim inString As String, inString2 As String
+Dim inString As String, inString2 As String
Dim inFloat As Single, inFloat2 As Single
Dim inDouble As Double, inDouble2 As Double
Dim inVariant, inVariant2
@@ -143,7 +143,7 @@ If inBool <> outBool Or inByte <> outByte Or inShort <> outShort Or inLong <> ou
inVariant <> outVariant Or NOT equalUnoObjects(obj, outObject) Or NOT _
equalArrays(arString(), outArray()) Or inDate <> outDate Or inCurrency <> outCurrency Or _
inSCode.Value <> outSCode.Value Or Not equalUnoObjects(objFoo, outUnknown) Or _
- inDecimal <> outDecimal Then
+ inDecimal <> outDecimal Then
runtest = -1
exit Function
End If
@@ -239,7 +239,7 @@ End If
'properties -------------------------------------------------------------------------
inBool = false
-outBool = true
+outBool = true
obj.prpBool = inBool
outBool = obj.prpBool
inByte = 11
@@ -307,7 +307,7 @@ If inBool <> outBool Or inByte <> outByte Or inShort <> outShort Or inLong <> ou
inDecimal <> outDecimal Then
runtest = -1
Exit Function
-End If
+End If
' ref parameter ------------------------------------------------------------------------
obj.inLong(0)
@@ -323,7 +323,7 @@ obj.inrefVariant(inVariant)
obj.outVariant(outVariant)
If inLong <> outLong Or inVariant <> outVariant Then
runtest = -1
- Exit Function
+ Exit Function
End If
outLong = 0
@@ -334,7 +334,7 @@ obj.prprefVariant = inVariant
outVariant = obj.prprefVariant
If inLong <> outLong Or inVariant <> outVariant Then
runtest = -1
- Exit Function
+ Exit Function
End If
@@ -463,8 +463,8 @@ If inLong2 <> outLong Then
End If
'named arguments-------------------------------------------------------------------------
-'all args As named args, different order
-obj.optional6(0, 0, 0, 0)
+'all args As named args, different order
+obj.optional6(0, 0, 0, 0)
inLong = 1
inLong2 = 2
inLong3 = 3
@@ -481,22 +481,22 @@ If inLong <> outLong Or inLong2 <> outLong2 _
Or inLong3 <> outLong3 Or inLong4 <> outLong4 Then
runtest = -1
Exit Function
-End If
+End If
'mixed positional and named args with omitted args
Dim scode_paramNotFound As New com.sun.star.bridge.oleautomation.SCode
scode_paramNotFound.Value = &h80020004
obj.optional6(0, 0, 0, 0)
-'val1 and val3 will be DISP_E_PARAMNOTFOUND
+'val1 and val3 will be DISP_E_PARAMNOTFOUND
obj.optional6(, inLong2, val4:=inLong4)
-Dim outSCode1, outSCode2
+Dim outSCode1, outSCode2
obj.optional7(outSCode, outLong2, outSCode2, outLong4)
If outSCode.Value <> scode_paramNotFound.Value Or inLong2 <> outLong2 _
Or outSCode2.Value <> scode_paramNotFound.Value Or inLong4 <> outLong4 Then
runtest = -1
Exit Function
-End If
+End If
'mixed positional and named args with omitted args as out -args
inLong = 1
@@ -599,7 +599,7 @@ If Not IsNull(oExplorer) Then
oExplorer.visible = true
oExplorer.Navigate2("http://www.openoffice.org")
Else
- MsgBox("Could not perform test with Internet Explorer!")
+ MsgBox("Could not perform test with Internet Explorer!")
End If
@@ -622,8 +622,6 @@ FOr counter = 0 To len1 - 1
equalArrays = false
Exit Function
End If
-Next
+Next
equalArrays = true
End Function
-
-
diff --git a/main/framework/test/test_componentenumeration.bas b/main/framework/test/test_componentenumeration.bas
index 66eedd5968..7df4f77288 100644
--- a/main/framework/test/test_componentenumeration.bas
+++ b/main/framework/test/test_componentenumeration.bas
@@ -1,5 +1,5 @@
rem *************************************************************
-rem
+rem
rem Licensed to the Apache Software Foundation (ASF) under one
rem or more contributor license agreements. See the NOTICE file
rem distributed with this work for additional information
@@ -7,16 +7,16 @@ rem regarding copyright ownership. The ASF licenses this file
rem to you under the Apache License, Version 2.0 (the
rem "License"); you may not use this file except in compliance
rem with the License. You may obtain a copy of the License at
-rem
+rem
rem http://www.apache.org/licenses/LICENSE-2.0
-rem
+rem
rem Unless required by applicable law or agreed to in writing,
rem software distributed under the License is distributed on an
rem "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
rem KIND, either express or implied. See the License for the
rem specific language governing permissions and limitations
rem under the License.
-rem
+rem
rem *************************************************************
rem _______________________________________________________________________________________________________________________________________
rem Test script for helper class "framework/helper/OComponentAccess and OComponentEnumeration.
@@ -50,7 +50,7 @@ Sub Main
if( xComponentAccess.hasElements <> TRUE ) then
msgbox "Error: xComponentAccess has no elements - but I can't believe it!"
exit Sub
- endif
+ endif
rem Method getElementType() must return the cppu type of XComponent.
rem Otherwise something is wrong or implementation has changed.
@@ -58,7 +58,7 @@ Sub Main
msgbox "Error: xComponentAccess return wrong type as element type! - Has implementation changed?"
exit Sub
endif
-
+
rem ___________________________________________________________________________________________________________________________________
rem Test interface XEnumerationAccess of helper OComponentAcces.
rem The return value must be a valid reference!
@@ -67,14 +67,14 @@ Sub Main
msgbox "Error: Could not create a component enumeration!"
exit Sub
endif
-
+
rem ___________________________________________________________________________________________________________________________________
rem Control service specification of helper class "framework/helper/OComponentEnumeration".
rem The follow output must occur: com.sun.star.lang.XTypeProvider
rem com.sun.star.lang.XEventListener
rem com.sun.star.container.XEnumeration
msgbox xComponentEnumeration.dbg_supportedInterfaces
-
+
rem ___________________________________________________________________________________________________________________________________
rem Test interface XEnumeration of helper OComponentEnumeration.
nElementCounter = 0
@@ -90,9 +90,9 @@ Sub Main
msgbox "Warning: The enumeration was empty. I think it's wrong ... please check it again."
endif
msgbox "Info: An enumeration with " + nElementCounter + " element(s) was detected."
-
+
rem ___________________________________________________________________________________________________________________________________
rem If this point arrived our test was successful.
msgbox "Test of framework/helper/OComponentAccess & OComponentEnumeration was successful!"
-
+
End Sub
diff --git a/main/framework/test/test_documentproperties.bas b/main/framework/test/test_documentproperties.bas
index 763e3d6f74..4190afbbd8 100644
--- a/main/framework/test/test_documentproperties.bas
+++ b/main/framework/test/test_documentproperties.bas
@@ -1,5 +1,5 @@
' *************************************************************
-'
+'
' Licensed to the Apache Software Foundation (ASF) under one
' or more contributor license agreements. See the NOTICE file
' distributed with this work for additional information
@@ -7,16 +7,16 @@
' to you under the Apache License, Version 2.0 (the
' "License")' you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
' KIND, either express or implied. See the License for the
' specific language governing permissions and limitations
' under the License.
-'
+'
' *************************************************************
Sub Main
@@ -536,7 +536,7 @@ Function Test_NormalUse_XPersist ( aDocumentProperties ) as Boolean
' Zur Kontrolle anzeigen
ShowProperties ( aDocumentProperties )
-
+
' Der Test war erfolgreich! Meldung ausgeben und zurueck zm Aufrufer.
' Ausschalten der Fehlerbehandlung
on Error goto 0
@@ -1096,7 +1096,7 @@ Function getNameContainerCount ( aDocumentProperties ) as Long
aNameField = aDocumentProperties.getElementNames ()
nElementCount% = UBound ( aNameField () )
-
+
' Da die Zaehlung bei 0 beginnt, und der ermittelte Wert die obere Grenze darstellt,
' muss hier eine 1 draufgeschlagen werden.
getNameContainerCount = nElementCount% + 1
diff --git a/main/framework/test/test_filterregistration.bas b/main/framework/test/test_filterregistration.bas
index df53aa5dfc..cca5aa7859 100644
--- a/main/framework/test/test_filterregistration.bas
+++ b/main/framework/test/test_filterregistration.bas
@@ -1,5 +1,5 @@
rem *************************************************************
-rem
+rem
rem Licensed to the Apache Software Foundation (ASF) under one
rem or more contributor license agreements. See the NOTICE file
rem distributed with this work for additional information
@@ -7,16 +7,16 @@ rem regarding copyright ownership. The ASF licenses this file
rem to you under the Apache License, Version 2.0 (the
rem "License"); you may not use this file except in compliance
rem with the License. You may obtain a copy of the License at
-rem
+rem
rem http://www.apache.org/licenses/LICENSE-2.0
-rem
+rem
rem Unless required by applicable law or agreed to in writing,
rem software distributed under the License is distributed on an
rem "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
rem KIND, either express or implied. See the License for the
rem specific language governing permissions and limitations
rem under the License.
-rem
+rem
rem *************************************************************
rem _______________________________________________________________________________________________________________________________________
rem Test script for registering or changing filter of our configuration.
diff --git a/main/framework/test/test_statusindicatorfactory.bas b/main/framework/test/test_statusindicatorfactory.bas
index 6c7103c2b7..688e35d7b7 100644
--- a/main/framework/test/test_statusindicatorfactory.bas
+++ b/main/framework/test/test_statusindicatorfactory.bas
@@ -1,5 +1,5 @@
rem *************************************************************
-rem
+rem
rem Licensed to the Apache Software Foundation (ASF) under one
rem or more contributor license agreements. See the NOTICE file
rem distributed with this work for additional information
@@ -7,16 +7,16 @@ rem regarding copyright ownership. The ASF licenses this file
rem to you under the Apache License, Version 2.0 (the
rem "License"); you may not use this file except in compliance
rem with the License. You may obtain a copy of the License at
-rem
+rem
rem http://www.apache.org/licenses/LICENSE-2.0
-rem
+rem
rem Unless required by applicable law or agreed to in writing,
rem software distributed under the License is distributed on an
rem "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
rem KIND, either express or implied. See the License for the
rem specific language governing permissions and limitations
rem under the License.
-rem
+rem
rem *************************************************************
Sub Main
diff --git a/main/migrationanalysis/src/driver_docs/sources/AnalysisDriver.bas b/main/migrationanalysis/src/driver_docs/sources/AnalysisDriver.bas
index edd2d37fbc..badfd00d55 100644
--- a/main/migrationanalysis/src/driver_docs/sources/AnalysisDriver.bas
+++ b/main/migrationanalysis/src/driver_docs/sources/AnalysisDriver.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "AnalysisDriver"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -314,7 +314,7 @@ Sub AnalyseDirectory()
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "AnalyseDirectory"
-
+
Dim iniFilePath As String
Dim startDir As String
Dim fileList As String
@@ -344,7 +344,7 @@ Sub AnalyseDirectory()
SetupWizardVariables fileList, storeToDir, resultsFile, _
mLogFilePath, resultsTemplate, bOverwriteResultsFile, bNewResultsFile, _
statFileName, mDebugLevel, outputType, singleFile
-
+
startDir = ProfileGetItem("Analysis", CINPUT_DIR, "", mIniFilePath)
nIncrementFileCounter = CLng(ProfileGetItem("Analysis", _
@@ -413,12 +413,12 @@ Sub AnalyseDirectory()
mIssuesClassificationDict.CompareMode = TextCompare
Set mIssuesCostDict = New Scripting.Dictionary
'mIssuesCostDict.CompareMode = TextCompare
-
+
Set mUserFormTypesDict = New Scripting.Dictionary
Set mIssuesDict = New Scripting.Dictionary
Set mMacroDict = New Scripting.Dictionary
Set mPreparedIssuesDict = New Scripting.Dictionary
-
+
'Write to Application log
Dim myAnalyser As MigrationAnalyser
Set myAnalyser = New MigrationAnalyser
@@ -430,10 +430,10 @@ Sub AnalyseDirectory()
WriteToLog "Analyzing", myFiles.item(index)
WriteToIni C_NEXT_FILE, myFiles.item(index)
mDocIndex = index
-
+
'Do Analysis
myAnalyser.DoAnalyse myFiles.item(index), mUserFormTypesDict, startDir, storeToDir, fso
-
+
AnalysedDocs.Add myAnalyser.Results
bResultsWaiting = True
@@ -488,11 +488,11 @@ FinalExit:
Set mIssuesDict = Nothing
Set mMacroDict = Nothing
Set mPreparedIssuesDict = Nothing
-
+
Set AnalysedDocs = Nothing
-
+
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -506,19 +506,19 @@ Function WriteResults(storeToDir As String, resultsFile As String, resultsTempla
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "WriteResults"
-
+
If InDocPreparation Then
If outputType = COUTPUT_TYPE_XML Or outputType = COUTPUT_TYPE_BOTH Then
WriteXMLOutput storeToDir, resultsFile, _
bOverwriteResultsFile, bNewResultsFile, AnalysedDocs, fso
End If
End If
-
+
If outputType = COUTPUT_TYPE_XLS Or outputType = COUTPUT_TYPE_BOTH Then
WriteXLSOutput storeToDir, resultsFile, fso.GetAbsolutePathName(resultsTemplate), _
bOverwriteResultsFile, bNewResultsFile, AnalysedDocs, fso
End If
-
+
WriteResults = True
bNewResultsFile = False
@@ -539,7 +539,7 @@ Function GetFilesToAnalyze_old(startDir As String, bIncludeSubdirs As Boolean, _
Dim fso As New FileSystemObject
Dim theResultsFile As String
theResultsFile = ProfileGetItem("Analysis", CINPUT_DIR, "c:\", mIniFilePath) & "\" & ProfileGetItem("Analysis", CRESULTS_FILE, "", mIniFilePath)
-
+
GetFilesToAnalyze = False
Dim searchTypes As Collection
@@ -548,7 +548,7 @@ Function GetFilesToAnalyze_old(startDir As String, bIncludeSubdirs As Boolean, _
If searchTypes.count = 0 Then
GoTo FinalExit
End If
-
+
Dim myDocFiles As CollectedFiles
Set myDocFiles = New CollectedFiles
With myDocFiles
@@ -562,7 +562,7 @@ Function GetFilesToAnalyze_old(startDir As String, bIncludeSubdirs As Boolean, _
End With
myDocFiles.Search rootDir:=startDir, FileSpecs:=searchTypes, _
IncludeSubdirs:=bIncludeSubdirs
-
+
If getAppSpecificApplicationName = CAPPNAME_WORD Then
Set myFiles = myDocFiles.WordFiles
ElseIf getAppSpecificApplicationName = CAPPNAME_EXCEL Then
@@ -573,33 +573,33 @@ Function GetFilesToAnalyze_old(startDir As String, bIncludeSubdirs As Boolean, _
WriteDebug currentFunctionName & " : invalid application " & getAppSpecificApplicationName
GoTo FinalExit
End If
-
+
GetFilesToAnalyze = True
FinalExit:
Set searchTypes = Nothing
Set myDocFiles = Nothing
-
+
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
End Function
-
+
Function GetFilesToAnalyze(fileList As String, startFile As String, _
myFiles As Collection) As Boolean
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "GetFilesToAnalyze"
-
+
Dim fso As New FileSystemObject
Dim fileContent As TextStream
Dim fileName As String
GetFilesToAnalyze = False
-
+
If (startFile = "") Then
If (fso.FileExists(fileList)) Then
Set fileContent = fso.OpenTextFile(fileList, ForReading, False, TristateTrue)
@@ -622,7 +622,7 @@ FinalExit:
Set fileContent = Nothing
Set fso = Nothing
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -635,12 +635,12 @@ Function GetPrepareFilesToAnalyze(resultsFilePath As String, myFiles As Collecti
currentFunctionName = "GetPrepareFilesToAnalyze"
GetPrepareFilesToAnalyze = False
-
+
If Not fso.FileExists(resultsFilePath) Then
WriteDebug currentFunctionName & ": results file does not exist : " & resultsFilePath
GoTo FinalExit
End If
-
+
'Open results spreadsheet
Dim xl As Excel.Application
If getAppSpecificApplicationName = CAPPNAME_EXCEL Then
@@ -652,7 +652,7 @@ Function GetPrepareFilesToAnalyze(resultsFilePath As String, myFiles As Collecti
End If
Dim logWb As WorkBook
Set logWb = xl.Workbooks.Open(resultsFilePath)
-
+
Dim wsDocProp As Worksheet
Set wsDocProp = logWb.Sheets(RID_STR_COMMON_RESULTS_SHEET_NAME_DOCPROP)
@@ -660,16 +660,16 @@ Function GetPrepareFilesToAnalyze(resultsFilePath As String, myFiles As Collecti
Dim endRow As Long
startRow = mDocPropRowOffset + 1
endRow = GetWorkbookNameValueAsLong(logWb, CTOTAL_DOCS_ANALYZED) + mDocPropRowOffset
-
+
GetPreparableFilesFromDocProps wsDocProp, startRow, endRow, fso, myFiles
-
+
GetPrepareFilesToAnalyze = (myFiles.count > 0)
FinalExit:
Set wsDocProp = Nothing
If Not logWb Is Nothing Then logWb.Close
Set logWb = Nothing
-
+
If getAppSpecificApplicationName <> CAPPNAME_EXCEL Then
If Not xl Is Nothing Then
If xl.Workbooks.count = 0 Then
@@ -678,9 +678,9 @@ FinalExit:
End If
End If
Set xl = Nothing
-
+
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -692,16 +692,16 @@ Function GetPreparableFilesFromDocProps(wsDocProp As Worksheet, startRow As Long
Dim currentFunctionName As String
currentFunctionName = "GetPreparableFilesFromDocProps"
GetPreparableFilesFromDocProps = False
-
+
Dim index As Long
Dim fileName As String
Dim fileExt As String
Dim docExt As String
Dim templateExt As String
-
+
docExt = getAppSpecificDocExt
templateExt = getAppSpecificTemplateExt
-
+
For index = startRow To endRow
If GetWorksheetCellValueAsLong(wsDocProp, index, CDOCINFOPREPAREDISSUES) > 0 Then
fileName = GetWorksheetCellValueAsString(wsDocProp, index, CDOCINFONAME)
@@ -713,11 +713,11 @@ Function GetPreparableFilesFromDocProps(wsDocProp As Worksheet, startRow As Long
End If
End If
Next index
-
+
GetPreparableFilesFromDocProps = myFiles.count > 0
FinalExit:
Exit Function
-
+
HandleErrors:
GetPreparableFilesFromDocProps = False
WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
@@ -907,12 +907,12 @@ Sub WriteXLSOutput(storeToDir As String, resultsFile As String, resultsTemplate
ProcessIssuesForDAW logWb, aAnalysis, fileName
WriteDocProperties wsPgStats, row + offsetDocPropRow, aAnalysis, fileName
End If
-
+
UpdateAllCounts aAnalysis, docCounts, templateCounts, macroClasses, issueClasses, fso
-
+
Set aAnalysis = Nothing
Next row
-
+
' We change the font used for text box shapes here for the japanese
' version, because office 2000 sometimes displays squares instead of
' chars
@@ -951,13 +951,13 @@ Sub WriteXLSOutput(storeToDir As String, resultsFile As String, resultsTemplate
End If
SetupPrintRanges logWb, row, issuesRow, issueDetailsRow, refDetailsRow
-
+
If resultsFile <> "" Then
'Overwrite existing results file without prompting
If bOverwriteResultsFile Or (Not bNewResultsFile) Then
xl.DisplayAlerts = False
End If
-
+
logWb.SaveAs fileName:=storeToDir & "\" & resultsFile
xl.DisplayAlerts = True
End If
@@ -966,7 +966,7 @@ FinalExit:
If Not xl Is Nothing Then
xl.Visible = True
End If
-
+
Set wsOverview = Nothing
Set wsPgStats = Nothing
@@ -976,10 +976,10 @@ FinalExit:
Set wsIssueDetails = Nothing
Set wsRefDetails = Nothing
End If
-
+
If Not logWb Is Nothing Then logWb.Close
Set logWb = Nothing
-
+
If getAppSpecificApplicationName <> CAPPNAME_EXCEL Then
If Not xl Is Nothing Then
If xl.Workbooks.count = 0 Then
@@ -988,9 +988,9 @@ FinalExit:
End If
End If
Set xl = Nothing
-
+
Exit Sub
-
+
HandleErrors:
xl.DisplayAlerts = False
@@ -1013,7 +1013,7 @@ Sub WriteIssueCounts(logWb As WorkBook)
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "WriteIssueCounts"
-
+
Dim Str As String
Dim str1 As String
Dim val1 As Long
@@ -1022,13 +1022,13 @@ Sub WriteIssueCounts(logWb As WorkBook)
Dim vItemArray As Variant
Dim vPrepKeyArray As Variant
Dim vPrepItemArray As Variant
-
+
vKeyArray = mIssuesDict.Keys
vItemArray = mIssuesDict.Items
-
+
vPrepKeyArray = mPreparedIssuesDict.Keys
vPrepItemArray = mPreparedIssuesDict.Items
-
+
'Write Issue Counts across all Documents
For count = 0 To mIssuesDict.count - 1
str1 = vKeyArray(count)
@@ -1037,7 +1037,7 @@ Sub WriteIssueCounts(logWb As WorkBook)
logWb.Names(str1).RefersToRange.Cells(1, 1).value + vItemArray(count)
'DEBUG: str = str & "Key: " & str1 & " Value: " & val1 & vbLf
Next count
-
+
'Write Prepared Issues Counts across all Documents
For count = 0 To mPreparedIssuesDict.count - 1
str1 = vPrepKeyArray(count)
@@ -1045,7 +1045,7 @@ Sub WriteIssueCounts(logWb As WorkBook)
AddVariantToWorkbookNameValue logWb, str1, vPrepItemArray(count)
'DEBUG: str = str & "Key: " & str1 & " Value: " & val1 & vbLf
Next count
-
+
'User Form control type count across all analyzed documents of this type
str1 = getAppSpecificApplicationName & "_" & _
CSTR_ISSUE_VBA_MACROS & "_" & _
@@ -1057,7 +1057,7 @@ Sub WriteIssueCounts(logWb As WorkBook)
If mUserFormTypesDict.count > 0 Then
vKeyArray = mUserFormTypesDict.Keys
vItemArray = mUserFormTypesDict.Items
-
+
Str = RID_STR_COMMON_ATTRIBUTE_CONTROLS & ": "
For count = 0 To mUserFormTypesDict.count - 1
Str = Str & vbLf & vKeyArray(count) & " " & vItemArray(count)
@@ -1070,7 +1070,7 @@ Sub WriteIssueCounts(logWb As WorkBook)
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : logging costs : " & _
@@ -1081,23 +1081,23 @@ Sub WriteUniqueModuleCount(logWb As WorkBook)
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "WriteUniqueModuleCount"
-
+
Dim strLabel As String
Dim uniqueLineCount As Long
Dim uniqueModuleCount As Long
Dim count As Long
Dim vItemArray As Variant
-
+
vItemArray = mMacroDict.Items
-
+
'Write Issues Costs
uniqueLineCount = 0
For count = 0 To mMacroDict.count - 1
uniqueLineCount = uniqueLineCount + CInt(vItemArray(count))
Next count
uniqueModuleCount = mMacroDict.count
-
-
+
+
strLabel = getAppSpecificApplicationName & "_" & _
CSTR_ISSUE_VBA_MACROS & "_" & _
CSTR_SUBISSUE_PROPERTIES & "_" & _
@@ -1112,7 +1112,7 @@ Sub WriteUniqueModuleCount(logWb As WorkBook)
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : logging Unique Module/ Line Counts : " & _
@@ -1127,7 +1127,7 @@ Sub WriteUserFromControlTypesComment(logWb As WorkBook, name As String, comment
On Error Resume Next 'Ignore error if trying to add comment again - would happen on append to results
logWb.Names(name).RefersToRange.Cells(1, 1).AddComment
-
+
On Error GoTo HandleErrors
logWb.Names(name).RefersToRange.Cells(1, 1).comment.Text Text:=comment
'Autosize not supported - Office 2000
@@ -1136,7 +1136,7 @@ Sub WriteUserFromControlTypesComment(logWb As WorkBook, name As String, comment
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : name : " & name & _
@@ -1151,7 +1151,7 @@ Sub UpdateAllCounts(aAnalysis As DocumentAnalysis, counts As DocumentCount, temp
Const CMODDATE_LESS3MONTHS = 91
Const CMODDATE_LESS6MONTHS = 182
Const CMODDATE_LESS12MONTHS = 365
-
+
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "UpdateAllCounts"
@@ -1159,7 +1159,7 @@ Sub UpdateAllCounts(aAnalysis As DocumentAnalysis, counts As DocumentCount, temp
' ProcessIssuesAndWriteDocIssueDetails when all DocIssues are being traversed.
'MacroClass for the Doc is setup at the end of the Analyze_Macros in DoAnalysis
'Mod Dates are determined in SetDocProperties in DoAnalysis
-
+
'DocMacroClassifications
Select Case aAnalysis.MacroOverallClass
Case enMacroComplex
@@ -1171,7 +1171,7 @@ Sub UpdateAllCounts(aAnalysis As DocumentAnalysis, counts As DocumentCount, temp
Case Else
macroClasses.None = macroClasses.None + 1
End Select
-
+
'DocIssueClassifications
aAnalysis.BelowIssuesLimit = True
Select Case aAnalysis.DocOverallIssueClass
@@ -1182,7 +1182,7 @@ Sub UpdateAllCounts(aAnalysis As DocumentAnalysis, counts As DocumentCount, temp
Case Else
issueClasses.None = issueClasses.None + 1
End Select
-
+
'DocumentCounts
Dim extStr As String
extStr = "." & LCase(fso.GetExtensionName(aAnalysis.name))
@@ -1194,10 +1194,10 @@ Sub UpdateAllCounts(aAnalysis As DocumentAnalysis, counts As DocumentCount, temp
WriteDebug currentFunctionName & " : path " & aAnalysis.name & _
": unhandled file extesnion " & extStr & " : " & Err.Number & " " & Err.Description & " " & Err.Source
End If
-
+
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -1210,7 +1210,7 @@ Sub UpdateDocCounts(counts As DocumentCount, aAnalysis As DocumentAnalysis)
counts.numDocsAnalyzed = counts.numDocsAnalyzed + 1
If aAnalysis.IssuesCount > 0 Then 'During Analysis incremented
counts.numDocsAnalyzedWithIssues = counts.numDocsAnalyzedWithIssues + 1
-
+
If aAnalysis.BelowIssuesLimit Then
counts.numMinorIssues = _
counts.numMinorIssues + aAnalysis.MinorIssuesCount
@@ -1221,14 +1221,14 @@ Sub UpdateDocCounts(counts As DocumentCount, aAnalysis As DocumentAnalysis)
counts.totalPreparableIssuesCosts = counts.totalPreparableIssuesCosts + _
aAnalysis.PreparableIssuesCosts
End If
-
+
counts.numMacroIssues = counts.numMacroIssues + aAnalysis.MacroIssuesCount 'During Analysis incremented
counts.totalMacroCosts = counts.totalMacroCosts + aAnalysis.MacroCosts
End If
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -1240,43 +1240,43 @@ Sub WriteDocProperties(wsPgStats As Worksheet, row As Long, aAnalysis As Documen
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "WriteDocProperties"
-
+
Dim rowIndex As Long
rowIndex = row + mDocPropRowOffset
-
+
If aAnalysis.Application = RID_STR_COMMON_CANNOT_OPEN Then
SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFONAME, fileName
SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOAPPLICATION, aAnalysis.Application
SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFONAMEANDPATH, aAnalysis.name
-
+
GoTo FinalExit
End If
-
+
If InDocPreparation Then
SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFONAME, fileName
SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOAPPLICATION, aAnalysis.Application
-
+
SetWorksheetCellValueToLong wsPgStats, rowIndex, CDOCINFODOCISSUECOSTS, aAnalysis.DocIssuesCosts
SetWorksheetCellValueToLong wsPgStats, rowIndex, CDOCINFOPREPARABLEISSUECOSTS, aAnalysis.PreparableIssuesCosts
SetWorksheetCellValueToLong wsPgStats, rowIndex, CDOCINFOMACROISSUECOSTS, aAnalysis.MacroCosts
-
+
SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOISSUE_CLASS, _
getDocOverallIssueClassificationAsString(aAnalysis.DocOverallIssueClass)
SetWorksheetCellValueToLong wsPgStats, rowIndex, CDOCINFOCOMPLEXISSUES, aAnalysis.ComplexIssuesCount
SetWorksheetCellValueToLong wsPgStats, rowIndex, CDOCINFOMINORISSUES, aAnalysis.MinorIssuesCount
SetWorksheetCellValueToLong wsPgStats, rowIndex, CDOCINFOPREPAREDISSUES, aAnalysis.PreparableIssuesCount
-
+
SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOMACRO_CLASS, _
getDocOverallMacroClassAsString(aAnalysis.MacroOverallClass)
SetWorksheetCellValueToLong wsPgStats, rowIndex, CDOCINFOMACRO_USERFORMS, aAnalysis.MacroNumUserForms
SetWorksheetCellValueToLong wsPgStats, rowIndex, CDOCINFOMACRO_LINESOFCODE, aAnalysis.MacroTotalNumLines
-
+
SetWorksheetCellValueToLong wsPgStats, rowIndex, CDOCINFONUMBERPAGES, aAnalysis.PageCount
SetWorksheetCellValueToVariant wsPgStats, rowIndex, CDOCINFOCREATED, CheckDate(aAnalysis.Created)
SetWorksheetCellValueToVariant wsPgStats, rowIndex, CDOCINFOLASTMODIFIED, CheckDate(aAnalysis.Modified)
SetWorksheetCellValueToVariant wsPgStats, rowIndex, CDOCINFOLASTACCESSED, CheckDate(aAnalysis.Accessed)
SetWorksheetCellValueToVariant wsPgStats, rowIndex, CDOCINFOLASTPRINTED, CheckDate(aAnalysis.Printed)
-
+
SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOLASTSAVEDBY, aAnalysis.SavedBy
SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOREVISION, aAnalysis.Revision
SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOTEMPLATE, aAnalysis.Template
@@ -1291,10 +1291,10 @@ Sub WriteDocProperties(wsPgStats As Worksheet, row As Long, aAnalysis As Documen
SetWorksheetCellValueToVariant wsPgStats, rowIndex, CDOCINFOLASTMODIFIED, CheckDate(aAnalysis.Modified)
SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFONAMEANDPATH, aAnalysis.name
End If
-
+
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : path " & aAnalysis.name & " : " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -1303,18 +1303,18 @@ Function CheckDate(myDate As Date) As Variant
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "CheckDate"
-
+
Dim lowerNTDateLimit As Date
If Not IsDate(myDate) Then
CheckDate = RID_STR_COMMON_NA
Exit Function
End If
-
+
lowerNTDateLimit = DateSerial(1980, 1, 1)
CheckDate = IIf(myDate < lowerNTDateLimit, RID_STR_COMMON_NA, myDate)
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : date " & myDate & " : " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -1336,7 +1336,7 @@ Function WriteDocIssues(wsIssues As Worksheet, row As Long, _
End If
SetWorksheetCellValueToString wsIssues, row, CNAME, fileName
SetWorksheetCellValueToString wsIssues, row, CAPPLICATION, aAnalysis.Application
-
+
Dim index As Integer
For index = 1 To aAnalysis.TotalIssueTypes
If aAnalysis.IssuesCountArray(index) > 0 Then
@@ -1344,11 +1344,11 @@ Function WriteDocIssues(wsIssues As Worksheet, row As Long, _
End If
Next index
SetWorksheetCellValueToString wsIssues, row, CISSUE_COLUMNOFFSET + aAnalysis.TotalIssueTypes + 1, aAnalysis.name
-
+
WriteDocIssues = row + 1
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : path " & aAnalysis.name & " : " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -1357,26 +1357,26 @@ Sub ProcessIssuesForDAW(logWb As WorkBook, aAnalysis As DocumentAnalysis, fileNa
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "ProcessIssuesForDAW"
-
+
Dim myIssue As IssueInfo
Dim issueClass As EnumDocOverallIssueClass
-
+
Dim index As Integer
For index = 1 To aAnalysis.Issues.count
Set myIssue = aAnalysis.Issues(index)
-
+
If Not isMacroIssue(myIssue) Then
issueClass = getDocIssueClassification(logWb, myIssue)
CountDocIssuesForDoc issueClass, aAnalysis
SetOverallDocIssueClassification issueClass, aAnalysis
End If
-
+
Set myIssue = Nothing
Next index
-
+
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -1387,18 +1387,18 @@ Function ProcessIssuesAndWriteDocIssueDetails(logWb As WorkBook, wsIssueDetails
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "ProcessIssueAndWriteDocIssueDetails"
-
+
Dim myIssue As IssueInfo
Dim rowIndex As Long
Dim issueClass As EnumDocOverallIssueClass
Dim issueCost As Long
-
+
rowIndex = DetailsRow
-
+
Dim index As Integer
For index = 1 To aAnalysis.Issues.count
Set myIssue = aAnalysis.Issues(index)
-
+
' Process Document Issues and Costs for the Document
' Will be output to List of Documents sheet by WriteDocProperties( )
If Not isMacroIssue(myIssue) Then
@@ -1411,22 +1411,22 @@ Function ProcessIssuesAndWriteDocIssueDetails(logWb As WorkBook, wsIssueDetails
aAnalysis.PreparableIssuesCosts = aAnalysis.PreparableIssuesCosts + issueCost
End If
End If
-
+
'Collate Issue and Factor counts across all Documents
'Will be output to the Issues Analyzed sheet by WriteIssueCounts( )
CollateIssueAndFactorCountsAcrossAllDocs aAnalysis, myIssue, fileName
-
+
OutputCommonIssueDetails wsIssueDetails, rowIndex, aAnalysis, myIssue, fileName
OutputCommonIssueAttributes wsIssueDetails, rowIndex, myIssue
rowIndex = rowIndex + 1
Set myIssue = Nothing
Next index
-
+
ProcessIssuesAndWriteDocIssueDetails = rowIndex
-
+
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -1436,19 +1436,19 @@ Function getDocIssueCost(logWb As WorkBook, aAnalysis As DocumentAnalysis, myIss
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "getDocIssueCost"
-
+
Dim issueKey As String
Dim ret As Long
ret = 0
-
+
issueKey = getAppSpecificApplicationName & "_" & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML
-
+
ret = getIssueValueFromXLSorDict(logWb, aAnalysis, mIssuesCostDict, issueKey, 1, CCOST_COL_OFFSET)
-
+
FinalExit:
getDocIssueCost = ret
Exit Function
-
+
HandleErrors:
ret = 0
WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
@@ -1459,7 +1459,7 @@ Function getMacroIssueCosts(logWb As WorkBook, aAnalysis As DocumentAnalysis) As
getMacroIssueCosts = getVBAMacroIssueCost(logWb, aAnalysis) '+ getMacroExtRefIssueCost(logWb, aAnalysis)
'NOTE: Currently not counting External Refs as Macro Cost
'could be added if porting off Windows
-
+
End Function
Function getVBAMacroIssueCost(logWb As WorkBook, aAnalysis As DocumentAnalysis) As Long
@@ -1467,25 +1467,25 @@ Function getVBAMacroIssueCost(logWb As WorkBook, aAnalysis As DocumentAnalysis)
Const CMACRO_ROW_OFFSET_USER_FORMS_COUNT_COST = 5
Const CMACRO_ROW_OFFSET_USER_FORMS_CONTROL_COUNT_COST = 6
Const CMACRO_ROW_OFFSET_USER_FORMS_CONTROL_TYPE_COUNT_COST = 7
-
+
Const CMACRO_NUM_OF_LINES_FACTOR_KEY = "_UniqueLineCount"
Const CMACRO_USER_FORMS_COUNT_FACTOR_KEY = "_UserFormsCount"
Const CMACRO_USER_FORMS_CONTROL_COUNT_FACTOR_KEY = "_UserFormsControlCount"
Const CMACRO_USER_FORMS_CONTROL_TYPE_COUNT_FACTOR_KEY = "_UserFormsControlTypeCount"
-
+
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "getVBAMacroIssueCost"
-
+
Dim baseIssueKey As String
Dim ret As Long
ret = 0
-
+
If Not aAnalysis.HasMacros Then GoTo FinalExit
-
+
'Fetch VBA Macro Cost Factors - if required
baseIssueKey = getAppSpecificApplicationName & "_" & CSTR_ISSUE_VBA_MACROS & "_" & CSTR_SUBISSUE_PROPERTIES
-
+
'Num Lines - Costing taken from "Lines in Unique Modules"
If aAnalysis.MacroTotalNumLines > 0 Then
ret = ret + aAnalysis.MacroTotalNumLines * _
@@ -1512,12 +1512,12 @@ Function getVBAMacroIssueCost(logWb As WorkBook, aAnalysis As DocumentAnalysis)
ret = ret + aAnalysis.MacroNumUserFormControlTypes * getValueFromXLSorDict(logWb, aAnalysis, mIssuesCostDict, _
baseIssueKey & CMACRO_USER_FORMS_CONTROL_TYPE_COUNT_FACTOR_KEY, baseIssueKey, CMACRO_ROW_OFFSET_USER_FORMS_CONTROL_TYPE_COUNT_COST, CCOST_COL_OFFSET)
End If
-
+
FinalExit:
getVBAMacroIssueCost = ret
Exit Function
-
+
HandleErrors:
ret = 0
WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
@@ -1526,16 +1526,16 @@ End Function
Function getMacroExtRefIssueCost(logWb As WorkBook, aAnalysis As DocumentAnalysis) As Long
Const CMACRO_ROW_OFFSET_NUM_EXTERNAL_REFS_COST = 2
Const CMACRO_NUM_EXTERNAL_REFS_FACTOR_KEY = "_ExternalRefs"
-
+
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "getMacroExtRefIssueCost"
Dim baseIssueKey As String
Dim ret As Long
ret = 0
-
+
If aAnalysis.MacroNumExternalRefs <= 0 Then GoTo FinalExit
-
+
'Fetch External Ref Cost Factors
baseIssueKey = getAppSpecificApplicationName & "_" & CSTR_ISSUE_PORTABILITY & "_" & _
CSTR_SUBISSUE_EXTERNAL_REFERENCES_IN_MACRO
@@ -1547,7 +1547,7 @@ Function getMacroExtRefIssueCost(logWb As WorkBook, aAnalysis As DocumentAnalysi
FinalExit:
getMacroExtRefIssueCost = ret
Exit Function
-
+
HandleErrors:
ret = 0
WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
@@ -1564,10 +1564,10 @@ Function getValueFromXLSorDict(logWb As WorkBook, aAnalysis As DocumentAnalysis,
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "getValueFromXLSorDict"
-
+
Dim ret As Long
ret = 0
-
+
If dict.Exists(dictKey) Then
ret = dict.item(dictKey)
Else
@@ -1587,7 +1587,7 @@ Function getValueFromXLSorDict(logWb As WorkBook, aAnalysis As DocumentAnalysis,
FinalExit:
getValueFromXLSorDict = ret
Exit Function
-
+
HandleErrors:
ret = 0
WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
@@ -1596,7 +1596,7 @@ End Function
Function isMacroIssue(myIssue As IssueInfo)
'Error handling not required
isMacroIssue = False
-
+
If myIssue.IssueTypeXML = CSTR_ISSUE_VBA_MACROS Or _
(myIssue.IssueTypeXML = CSTR_ISSUE_PORTABILITY And _
myIssue.SubTypeXML = CSTR_SUBISSUE_EXTERNAL_REFERENCES_IN_MACRO) Then
@@ -1605,7 +1605,7 @@ Function isMacroIssue(myIssue As IssueInfo)
End Function
Sub CountDocIssuesForDoc(issueClass As EnumDocOverallIssueClass, aAnalysis As DocumentAnalysis)
'Error handling not required
-
+
If issueClass = enMinor Then
aAnalysis.MinorIssuesCount = aAnalysis.MinorIssuesCount + 1
End If
@@ -1614,9 +1614,9 @@ Sub CountDocIssuesForDoc(issueClass As EnumDocOverallIssueClass, aAnalysis As Do
End Sub
Sub SetOverallDocIssueClassification(issueClass As EnumDocOverallIssueClass, aAnalysis As DocumentAnalysis)
'Error handling not required
-
+
If aAnalysis.DocOverallIssueClass = enComplex Then Exit Sub
-
+
If issueClass = enComplex Then
aAnalysis.DocOverallIssueClass = enComplex
Else
@@ -1631,7 +1631,7 @@ Function getDocIssueClassification(logWb As WorkBook, myIssue As IssueInfo) As E
Dim bRet As Boolean
bRet = False
getDocIssueClassification = enMinor
-
+
issueKey = getAppSpecificApplicationName & "_" & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML
If mIssuesClassificationDict.Exists(issueKey) Then
bRet = mIssuesClassificationDict.item(issueKey)
@@ -1654,7 +1654,7 @@ FinalExit:
getDocIssueClassification = enComplex
End If
Exit Function
-
+
HandleErrors:
bRet = False
WriteDebug currentFunctionName & " : issueKey " & issueKey & ": " & Err.Number & " " & Err.Description & " " & Err.Source
@@ -1664,7 +1664,7 @@ End Function
Function getDocOverallIssueClassificationAsString(docIssueClass As EnumDocOverallIssueClass) As String
Dim Str As String
'Error handling not required
-
+
Select Case docIssueClass
Case enComplex
Str = RID_STR_COMMON_ISSUE_CLASS_COMPLEX
@@ -1673,14 +1673,14 @@ Function getDocOverallIssueClassificationAsString(docIssueClass As EnumDocOveral
Case Else
Str = RID_STR_COMMON_ISSUE_CLASS_NONE
End Select
-
+
getDocOverallIssueClassificationAsString = Str
End Function
Public Function getDocOverallMacroClassAsString(docMacroClass As EnumDocOverallMacroClass) As String
Dim Str As String
'Error handling not required
-
+
Select Case docMacroClass
Case enMacroComplex
Str = RID_STR_COMMON_MACRO_CLASS_COMPLEX
@@ -1691,7 +1691,7 @@ Public Function getDocOverallMacroClassAsString(docMacroClass As EnumDocOverallM
Case Else
Str = RID_STR_COMMON_MACRO_CLASS_NONE
End Select
-
+
getDocOverallMacroClassAsString = Str
End Function
@@ -1700,13 +1700,13 @@ Function WriteDocRefDetails(wsRefDetails As Worksheet, DetailsRow As Long, _
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "WriteDocRefDetails"
-
+
Dim myIssue As IssueInfo
Dim rowIndex As Long
rowIndex = DetailsRow
-
+
Dim index As Integer
-
+
'Output References for Docs with Macros
If aAnalysis.HasMacros And (aAnalysis.References.count > 0) Then
For index = 1 To aAnalysis.References.count
@@ -1716,12 +1716,12 @@ Function WriteDocRefDetails(wsRefDetails As Worksheet, DetailsRow As Long, _
Set myIssue = Nothing
Next index
End If
-
+
WriteDocRefDetails = rowIndex
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : path " & aAnalysis.name & ": " & _
@@ -1734,27 +1734,27 @@ Sub OutputReferenceAttributes(wsIssueDetails As Worksheet, rowIndex As Long, _
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "OutputReferenceAttributes"
-
+
Dim strAttributes As String
-
+
With myIssue
SetWorksheetCellValueToString wsIssueDetails, rowIndex, CREF_DETDOCNAME, fileName
SetWorksheetCellValueToString wsIssueDetails, rowIndex, CREF_DETDOCAPPLICATION, aAnalysis.Application
-
+
strAttributes = .Values(RID_STR_COMMON_ATTRIBUTE_MAJOR) & "." & .Values(RID_STR_COMMON_ATTRIBUTE_MINOR)
strAttributes = IIf(strAttributes = "0.0" Or strAttributes = ".", .Values(RID_STR_COMMON_ATTRIBUTE_NAME), _
.Values(RID_STR_COMMON_ATTRIBUTE_NAME) & " " & .Values(RID_STR_COMMON_ATTRIBUTE_MAJOR) & _
"." & .Values(RID_STR_COMMON_ATTRIBUTE_MINOR))
SetWorksheetCellValueToString wsIssueDetails, rowIndex, CREF_DETREFERENCE, strAttributes
-
+
If .Values(RID_STR_COMMON_ATTRIBUTE_TYPE) = RID_STR_COMMON_ATTRIBUTE_PROJECT Then
SetWorksheetCellValueToString wsIssueDetails, rowIndex, CREF_DETDESCRIPTION, RID_STR_COMMON_ATTRIBUTE_PROJECT
Else
SetWorksheetCellValueToString wsIssueDetails, rowIndex, CREF_DETDESCRIPTION, _
IIf(.Values(RID_STR_COMMON_ATTRIBUTE_DESCRIPTION) <> "", .Values(RID_STR_COMMON_ATTRIBUTE_DESCRIPTION), RID_STR_COMMON_NA)
End If
-
-
+
+
If .Values(RID_STR_COMMON_ATTRIBUTE_ISBROKEN) <> RID_STR_COMMON_ATTRIBUTE_BROKEN Then
SetWorksheetCellValueToString wsIssueDetails, rowIndex, CREF_DETLOCATION, _
.Values(RID_STR_COMMON_ATTRIBUTE_FILE)
@@ -1762,7 +1762,7 @@ Sub OutputReferenceAttributes(wsIssueDetails As Worksheet, rowIndex As Long, _
SetWorksheetCellValueToString wsIssueDetails, rowIndex, CREF_DETLOCATION, _
RID_STR_COMMON_NA
End If
-
+
'Reference Details
strAttributes = RID_STR_COMMON_ATTRIBUTE_TYPE & ": " & .Values(RID_STR_COMMON_ATTRIBUTE_TYPE) & vbLf
strAttributes = strAttributes & RID_STR_COMMON_ATTRIBUTE_PROPERTIES & ": " & _
@@ -1771,12 +1771,12 @@ Sub OutputReferenceAttributes(wsIssueDetails As Worksheet, rowIndex As Long, _
strAttributes & vbLf & RID_STR_COMMON_ATTRIBUTE_GUID & ": " & .Values(RID_STR_COMMON_ATTRIBUTE_GUID), _
strAttributes)
SetWorksheetCellValueToString wsIssueDetails, rowIndex, CREF_DETATTRIBUTES, strAttributes
-
+
SetWorksheetCellValueToString wsIssueDetails, rowIndex, CREF_DETNAMEANDPATH, aAnalysis.name
End With
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : path " & aAnalysis.name & ": " & _
@@ -1790,22 +1790,22 @@ Sub OutputCommonIssueAttributes(wsIssueDetails As Worksheet, rowIndex As Long, _
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "OutputCommonIssueAttributes"
-
+
Dim index As Integer
Dim strAttributes As String
-
+
strAttributes = ""
For index = 1 To myIssue.Attributes.count
strAttributes = strAttributes & myIssue.Attributes(index) & " - " & _
myIssue.Values(index)
strAttributes = strAttributes & IIf(index <> myIssue.Attributes.count, vbLf, "")
-
+
Next index
SetWorksheetCellValueToString wsIssueDetails, rowIndex, CISSUE_DETATTRIBUTES, strAttributes
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : rowIndex " & rowIndex & ": " & _
@@ -1819,16 +1819,16 @@ Sub CollateIssueAndFactorCountsAcrossAllDocs(aAnalysis As DocumentAnalysis, myIs
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "CollateIssueAndFactorCountsAcrossAllDocs"
-
+
'Don't want to cost ISSUE_INFORMATION issues
If myIssue.IssueTypeXML = CSTR_ISSUE_INFORMATION Then Exit Sub
-
+
Dim issueKey As String
issueKey = getAppSpecificApplicationName & "_" & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML
-
+
'Store costing metrics for Issue
AddIssueAndOneToDict issueKey
-
+
'Store prepeared issue for costing metrics
If myIssue.Preparable Then
AddPreparedIssueAndOneToDict issueKey & "_Prepared"
@@ -1837,32 +1837,32 @@ Sub CollateIssueAndFactorCountsAcrossAllDocs(aAnalysis As DocumentAnalysis, myIs
'Additional costing Factors output for VB macros
If (myIssue.IssueTypeXML = CSTR_ISSUE_VBA_MACROS) And _
(myIssue.SubTypeXML <> CSTR_SUBISSUE_MACRO_PASSWORD_PROTECTION) Then
-
+
'Unique Macro Module and Line count
AddMacroModuleHashToMacroDict myIssue
-
+
'Line count
AddIssueAndValToDict issueKey & "_" & CSTR_SUBISSUE_VBA_MACROS_NUMLINES, myIssue, _
RID_STR_COMMON_ATTRIBUTE_NUMBER_OF_LINES
-
+
'User From info
If myIssue.SubLocation = CSTR_USER_FORM Then
AddIssueAndOneToDict issueKey & "_" & CSTR_SUBISSUE_VBA_MACROS_USERFORMS_COUNT
-
+
AddIssueAndValToDict issueKey & "_" & CSTR_SUBISSUE_VBA_MACROS_USERFORMS_CONTROL_COUNT, myIssue, _
RID_STR_COMMON_ATTRIBUTE_CONTROLS
End If
'Additional costing Factors output for External References
ElseIf (myIssue.IssueTypeXML = CSTR_ISSUE_PORTABILITY And _
myIssue.SubTypeXML = CSTR_SUBISSUE_EXTERNAL_REFERENCES_IN_MACRO) Then
-
+
AddIssueAndValToDict issueKey & "_" & CSTR_SUBISSUE_EXTERNAL_REFERENCES_IN_MACRO_COUNT, myIssue, _
RID_STR_COMMON_ATTRIBUTE_NON_PORTABLE_EXTERNAL_REFERENCES_COUNT
End If
-
+
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : path " & aAnalysis.name & ": " & _
@@ -1877,7 +1877,7 @@ Sub OutputCommonIssueDetails(wsIssueDetails As Worksheet, rowIndex As Long, _
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "OutputCommonIssueDetails"
-
+
SetWorksheetCellValueToString wsIssueDetails, rowIndex, CISSUE_DETDOCNAME, fileName
SetWorksheetCellValueToString wsIssueDetails, rowIndex, CISSUE_DETDOCAPPLICATION, aAnalysis.Application
SetWorksheetCellValueToString wsIssueDetails, rowIndex, CISSUE_DETTYPE, myIssue.IssueType
@@ -1894,7 +1894,7 @@ Sub OutputCommonIssueDetails(wsIssueDetails As Worksheet, rowIndex As Long, _
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : path " & aAnalysis.name & ": " & _
@@ -1908,7 +1908,7 @@ Sub AddIssueAndBoolValToDict(issueKey As String, issue As IssueInfo, valKey As S
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "AddIssueAndBoolValToDict"
-
+
If mIssuesDict.Exists(issueKey) Then
mIssuesDict.item(issueKey) = mIssuesDict.item(issueKey) + _
IIf(issue.Values(valKey) > 0, 1, 0)
@@ -1917,7 +1917,7 @@ Sub AddIssueAndBoolValToDict(issueKey As String, issue As IssueInfo, valKey As S
End If
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : issueKey " & issueKey & ": " & _
@@ -1929,7 +1929,7 @@ Sub AddIssueAndValToDict(issueKey As String, issue As IssueInfo, valKey As Strin
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "AddIssueAndValToDict"
-
+
If mIssuesDict.Exists(issueKey) Then
mIssuesDict.item(issueKey) = mIssuesDict.item(issueKey) + issue.Values(valKey)
Else
@@ -1937,7 +1937,7 @@ Sub AddIssueAndValToDict(issueKey As String, issue As IssueInfo, valKey As Strin
End If
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : issueKey " & issueKey & ": " & _
@@ -1952,16 +1952,16 @@ Sub AddMacroModuleHashToMacroDict(issue As IssueInfo)
Dim issueKey As String
Dim issueVal As String
currentFunctionName = "AddMacroModuleHashToMacroDict"
-
+
issueKey = issue.Values(RID_STR_COMMON_ATTRIBUTE_SIGNATURE)
If issueKey = RID_STR_COMMON_NA Then Exit Sub
-
+
If Not mMacroDict.Exists(issueKey) Then
mMacroDict.Add issueKey, issue.Values(RID_STR_COMMON_ATTRIBUTE_NUMBER_OF_LINES)
End If
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : issueKey " & issueKey & ": " & _
@@ -1981,7 +1981,7 @@ Sub AddIssueAndOneToDict(key As String)
End If
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : key " & key & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -1999,7 +1999,7 @@ Sub AddPreparedIssueAndOneToDict(key As String)
End If
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : key " & key & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2009,7 +2009,7 @@ Function GetExcelInstance() As Excel.Application
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "GetExcelInstance"
-
+
Dim xl As Excel.Application
On Error Resume Next
'Try and get an existing instance
@@ -2025,7 +2025,7 @@ Function GetExcelInstance() As Excel.Application
Set xl = Nothing
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2036,52 +2036,52 @@ Sub WriteOverview(logWb As WorkBook, DocCount As DocumentCount, templateCount As
Const COV_ISSUECLASS_COMPLEX = "MAW_ISSUECLASS_COMPLEX"
Const COV_ISSUECLASS_MINOR = "MAW_ISSUECLASS_MINOR"
Const COV_ISSUECLASS_NONE = "MAW_ISSUECLASS_NONE"
-
+
Const COV_MACROCLASS_COMPLEX = "MAW_MACROCLASS_COMPLEX"
Const COV_MACROCLASS_MEDIUM = "MAW_MACROCLASS_MEDIUM"
Const COV_MACROCLASS_SIMPLE = "MAW_MACROCLASS_SIMPLE"
Const COV_MACROCLASS_NONE = "MAW_MACROCLASS_NONE"
-
+
Const COV_ISSUECOUNT_COMPLEX = "MAW_ISSUECOUNT_COMPLEX"
Const COV_ISSUECOUNT_MINOR = "MAW_ISSUECOUNT_MINOR"
-
+
Const COV_MODDATES_LESS3MONTHS = "MAW_MODDATES_LESS3MONTHS"
Const COV_MODDATES_3TO6MONTHS = "MAW_MODDATES_3TO6MONTHS"
Const COV_MODDATES_6TO12MONTHS = "MAW_MODDATES_6TO12MONTHS"
Const COV_MODDATES_MORE12MONTHS = "MAW_MODDATES_MORE12MONTHS"
-
+
Const COV_DOC_MIGRATION_COSTS = "Document_Migration_Costs"
Const COV_DOC_PREPARABLE_COSTS = "Document_Migration_Preparable_Costs"
Const COV_MACRO_MIGRATION_COSTS = "Macro_Migration_Costs"
-
+
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "WriteOverview"
-
+
Dim appName As String
appName = getAppSpecificApplicationName
-
+
'OV - Title
SetWorkbookNameValueToString logWb, COVERVIEW_TITLE_LABEL, GetTitle
SetWorkbookNameValueToVariant logWb, "AnalysisDate", Now
SetWorkbookNameValueToString logWb, "AnalysisVersion", _
RID_STR_COMMON_OV_VERSION_STR & ": " & GetTitle & " " & GetVersion
-
+
'OV - Number of Documents Analyzed
AddLongToWorkbookNameValue logWb, CNUMBERDOC_ALL & getAppSpecificDocExt, DocCount.numDocsAnalyzed
AddLongToWorkbookNameValue logWb, CNUMBERDOC_ALL & getAppSpecificTemplateExt, templateCount.numDocsAnalyzed
-
+
'OV - Documents with Document Migration Issues (excludes macro issues)
AddLongToWorkbookNameValue logWb, appName & "_" & COV_ISSUECLASS_COMPLEX, issueClasses.complex
AddLongToWorkbookNameValue logWb, appName & "_" & COV_ISSUECLASS_MINOR, issueClasses.Minor
AddLongToWorkbookNameValue logWb, appName & "_" & COV_ISSUECLASS_NONE, issueClasses.None
-
+
'OV - Documents with Macro Migration Issues
AddLongToWorkbookNameValue logWb, appName & "_" & COV_MACROCLASS_COMPLEX, macroClasses.complex
AddLongToWorkbookNameValue logWb, appName & "_" & COV_MACROCLASS_MEDIUM, macroClasses.Medium
AddLongToWorkbookNameValue logWb, appName & "_" & COV_MACROCLASS_SIMPLE, macroClasses.Simple
AddLongToWorkbookNameValue logWb, appName & "_" & COV_MACROCLASS_NONE, macroClasses.None
-
+
'OV - Document Modification Dates
Dim modDates As DocModificationDates
Call GetDocModificationDates(modDates)
@@ -2098,27 +2098,27 @@ Sub WriteOverview(logWb As WorkBook, DocCount As DocumentCount, templateCount As
DocCount.numComplexIssues + templateCount.numComplexIssues
AddLongToWorkbookNameValue logWb, appName & "_" & COV_ISSUECOUNT_MINOR, _
DocCount.numMinorIssues + templateCount.numMinorIssues
-
+
'OV - Document Migration Costs
AddLongToWorkbookNameValue logWb, appName & "_" & COV_DOC_MIGRATION_COSTS, _
DocCount.totalDocIssuesCosts + templateCount.totalDocIssuesCosts
-
+
'OV - Document Migration Preparable Costs
AddLongToWorkbookNameValue logWb, COV_DOC_PREPARABLE_COSTS, _
DocCount.totalPreparableIssuesCosts + templateCount.totalPreparableIssuesCosts
-
+
'OV - Macro Migration Costs
AddLongToWorkbookNameValue logWb, appName & "_" & COV_MACRO_MIGRATION_COSTS, _
DocCount.totalMacroCosts + templateCount.totalMacroCosts
End If
-
+
'OV - Internal Attributes
AddLongToWorkbookNameValue logWb, appName & "_" & "TotalDocsAnalysedWithIssues", _
DocCount.numDocsAnalyzedWithIssues + templateCount.numDocsAnalyzedWithIssues
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : Problem writing overview: " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2130,9 +2130,9 @@ Sub SetupDAWResultsSpreadsheet(logWb As WorkBook, fontName As String, fontSize A
currentFunctionName = "SetupDAWResultsSpreadsheet"
Dim bSetupRun As Boolean
bSetupRun = CBool(GetWorkbookNameValueAsLong(logWb, COV_DAW_SETUP_SHEETS_RUN_LBL))
-
+
If bSetupRun Then Exit Sub
-
+
'Setup Text Boxes
SetupSheetTextBox logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_MOD_DATES_COMMENT_TXB, _
RID_STR_COMMON_OV_DOC_MOD_DATES_COMMENT_TITLE, RID_STR_COMMON_OV_DOC_MOD_DATES_COMMENT_BODY, _
@@ -2150,7 +2150,7 @@ Sub SetupDAWResultsSpreadsheet(logWb As WorkBook, fontName As String, fontSize A
IIf(monthLimit <> CMAX_LIMIT, _
ReplaceTopicTokens(RID_STR_COMMON_OV_HIGH_LEVEL_ANALYSIS_DAW, CR_TOPIC, CStr(monthLimit)), _
RID_STR_COMMON_OV_HIGH_LEVEL_ANALYSIS_PAW_NO_LIMIT)
-
+
SetupSheetTextBox logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_ANALYSIS_COMMENT_TXB, _
RID_STR_COMMON_OV_DOC_ANALYSIS_COMMENT_TITLE, RID_STR_COMMON_OV_DOC_ANALYSIS_COMMENT_BODY, _
CCOMMENTS_FONT_SIZE, fontName
@@ -2164,15 +2164,15 @@ Sub SetupDAWResultsSpreadsheet(logWb As WorkBook, fontName As String, fontSize A
RID_STR_COMMON_OV_DOC_MACRO_CHART_TITLE
SetupSheetChartTitles logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_ANALYSIS_CHART, _
RID_STR_COMMON_OV_DOC_ANALYSIS_CHART_TITLE
-
+
'Set selection to top cell of Overview
logWb.Sheets(RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW).Range("A1").Select
-
+
bSetupRun = True
SetWorkbookNameValueToBoolean logWb, COV_DAW_SETUP_SHEETS_RUN_LBL, bSetupRun
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : Problem setting up spreadsheet for DAW: " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2184,12 +2184,12 @@ Sub SetupPAWResultsSpreadsheet(logWb As WorkBook, fontName As String, fontSize A
currentFunctionName = "SetupPAWResultsSpreadsheet"
Dim bSetupRun As Boolean
bSetupRun = CBool(GetWorkbookNameValueAsLong(logWb, COV_PAW_SETUP_SHEETS_RUN_LBL))
-
+
If bSetupRun Then Exit Sub
-
+
'Costs
logWb.Names(COV_COSTS_PREPISSUE_COUNT_COL_LBL).RefersToRange.EntireColumn.Hidden = False
-
+
'Setup Text Boxes
SetupSheetTextBox logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_MOD_DATES_LEGEND_TXB, _
RID_STR_COMMON_OV_LEGEND_TITLE, RID_STR_COMMON_OV_DOC_MOD_DATES_LEGEND_BODY, fontSize, fontName
@@ -2199,7 +2199,7 @@ Sub SetupPAWResultsSpreadsheet(logWb As WorkBook, fontName As String, fontSize A
RID_STR_COMMON_OV_HIGH_LEVEL_ANALYSIS_PAW_NO_LIMIT
SetupSheetTextBox logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_ANALYSIS_LEGEND_PAW_TXB, _
RID_STR_COMMON_OV_LEGEND_TITLE, RID_STR_COMMON_OV_DOC_ANALYSIS_PAW_LEGEND_BODY, fontSize, fontName
-
+
'Setup Chart Titles
SetupSheetChartTitles logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_MOD_DATES_CHART, _
RID_STR_COMMON_OV_DOC_MOD_DATES_CHART_TITLE
@@ -2207,16 +2207,16 @@ Sub SetupPAWResultsSpreadsheet(logWb As WorkBook, fontName As String, fontSize A
RID_STR_COMMON_OV_DOC_MACRO_CHART_TITLE
SetupSheetChartTitles logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_ANALYSIS_CHART, _
RID_STR_COMMON_OV_DOC_ANALYSIS_CHART_TITLE
-
+
'Set selection to top cell of Overview
logWb.Sheets(RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW).Range("A1").Select
bSetupRun = True
SetWorkbookNameValueToBoolean logWb, COV_PAW_SETUP_SHEETS_RUN_LBL, bSetupRun
-
+
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : Problem setting up spreadsheet for PAW: " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2227,10 +2227,10 @@ Sub SetupPrintRanges(logWb As WorkBook, docPropRow As Long, appIssuesRow As Long
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "SetupPrintRanges"
-
+
'Set Print Ranges
If InDocPreparation Then
-
+
logWb.Worksheets(RID_STR_COMMON_RESULTS_SHEET_NAME_DOCPROP).PageSetup.PrintArea = "$A1:$U" & (docPropRow + mDocPropRowOffset)
logWb.Worksheets(RID_STR_COMMON_RESULTS_SHEET_NAME_DOCISSUE_DETAILS).PageSetup.PrintArea = "$A1:$J" & issueDetailsRow
logWb.Worksheets(RID_STR_COMMON_RESULTS_SHEET_NAME_DOCREF_DETAILS).PageSetup.PrintArea = "$A1:$G" & refDetailsRow
@@ -2247,10 +2247,10 @@ Sub SetupPrintRanges(logWb As WorkBook, docPropRow As Long, appIssuesRow As Long
Else
logWb.Worksheets(RID_STR_COMMON_RESULTS_SHEET_NAME_DOCPROP).PageSetup.PrintArea = "$A1:$U" & (docPropRow + mDocPropRowOffset)
End If
-
+
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : Problem setting print ranges: " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2262,7 +2262,7 @@ Sub SetupSheetChartTitles(logWb As WorkBook, namedWorksheet As String, namedChar
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "SetupSheetChartTitles"
-
+
With logWb.Sheets(namedWorksheet).ChartObjects(namedChart).Chart
.HasTitle = True
.chartTitle.Characters.Text = chartTitle
@@ -2271,7 +2271,7 @@ Sub SetupSheetChartTitles(logWb As WorkBook, namedWorksheet As String, namedChar
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" namedWorkSheet: " & namedWorksheet & _
@@ -2289,21 +2289,21 @@ Sub SetupSheetTextBox(logWb As WorkBook, namedWorksheet As String, _
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "SetupSheetTextBox"
-
+
Dim strTextBody As String
Dim allText As String
strTextBody = ReplaceTopic2Tokens(textBoxBody, CR_STR, Chr(10), CR_PRODUCT, RID_STR_COMMON_OV_PRODUCT_STR)
-
+
'Setup Text Boxes
logWb.Sheets(namedWorksheet).Activate
logWb.Sheets(namedWorksheet).Shapes(textBoxName).Select
-
+
'*** Workaround Excel bug: 213841 XL: Passed Strings Longer Than 255 Characters Are Truncated
Dim I As Long
logWb.Application.Selection.Text = ""
-
+
logWb.Application.Selection.Characters.Text = textBoxTitle & Chr(10)
-
+
With logWb.Application.Selection
For I = 0 To Int(Len(strTextBody) / CMAX_INSERTABLE_STRING_LEN)
.Characters(.Characters.count + 1).Text = Mid(strTextBody, _
@@ -2346,7 +2346,7 @@ Function GetWorkbookNameValueAsLong(logWb As WorkBook, name As String) As Long
FinalExit:
Exit Function
-
+
HandleErrors:
GetWorkbookNameValueAsLong = 0
WriteDebug currentFunctionName & " : name " & name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
@@ -2362,7 +2362,7 @@ Function GetWorksheetCellValueAsLong(logWs As Worksheet, row As Long, col As Lon
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : row " & row & _
@@ -2370,7 +2370,7 @@ HandleErrors:
Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
End Function
-
+
Function GetWorksheetCellValueAsString(logWs As Worksheet, row As Long, col As Long) As String
On Error GoTo HandleErrors
Dim currentFunctionName As String
@@ -2380,17 +2380,17 @@ Function GetWorksheetCellValueAsString(logWs As Worksheet, row As Long, col As L
FinalExit:
Exit Function
-
+
HandleErrors:
GetWorksheetCellValueAsString = ""
-
+
WriteDebug currentFunctionName & _
" : row " & row & _
" : col " & col & _
Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
End Function
-
+
Sub SetWorksheetCellValueToLong(logWs As Worksheet, row As Long, col As Long, val As Long)
On Error GoTo HandleErrors
Dim currentFunctionName As String
@@ -2400,7 +2400,7 @@ Sub SetWorksheetCellValueToLong(logWs As Worksheet, row As Long, col As Long, va
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : row " & row & _
@@ -2418,7 +2418,7 @@ Sub SetWorksheetCellValueToInteger(logWs As Worksheet, row As Long, col As Long,
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : row " & row & _
@@ -2437,7 +2437,7 @@ Sub SetWorksheetCellValueToVariant(logWs As Worksheet, row As Long, col As Long,
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : row " & row & _
@@ -2456,7 +2456,7 @@ Sub SetWorksheetCellValueToString(logWs As Worksheet, row As Long, col As Long,
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : row " & row & _
@@ -2475,7 +2475,7 @@ Sub SetWorkbookNameValueToBoolean(logWb As WorkBook, name As String, bVal As Boo
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : name " & name & " : boolean value " & bVal & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2490,7 +2490,7 @@ Sub SetWorkbookNameValueToString(logWb As WorkBook, name As String, val As Strin
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : name " & name & " : value " & val & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2505,7 +2505,7 @@ Sub SetWorkbookNameValueToLong(logWb As WorkBook, name As String, val As Long)
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : name " & name & " : value " & val & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2520,7 +2520,7 @@ Sub SetWorkbookNameValueToVariant(logWb As WorkBook, name As String, val As Vari
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : name " & name & " : value " & val & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2535,7 +2535,7 @@ Sub AddLongToWorkbookNameValue(logWb As WorkBook, name As String, val As Long)
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : name " & name & " : value " & val & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2549,7 +2549,7 @@ Sub AddVariantToWorkbookNameValue(logWb As WorkBook, name As String, varVal As V
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : name " & name & " : value " & varVal & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2560,13 +2560,13 @@ Sub SaveAnalysisResultsVariables(logWb As WorkBook, offsetDocIssueDetailsRow As
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "SaveAnalysisResultsVariables"
-
+
'OV - Internal Attributes
SetWorkbookNameValueToLong logWb, "TotalIssuesAnalysed", offsetDocIssueDetailsRow
SetWorkbookNameValueToLong logWb, "TotalRefsAnalysed", offsetDocRefDetailsRow
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : offsetDocIssueDetailsRow " & offsetDocIssueDetailsRow & _
" : offsetDocRefDetailsRow " & offsetDocRefDetailsRow & ": " & Err.Number & " " & Err.Description & " " & Err.Source
@@ -2579,14 +2579,14 @@ Sub SetupAnalysisResultsVariables(logWb As WorkBook, _
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "SetupAnalysisResultsVariables"
-
+
offsetDocPropRow = GetWorkbookNameValueAsLong(logWb, CTOTAL_DOCS_ANALYZED)
offsetDocIssueDetailsRow = GetWorkbookNameValueAsLong(logWb, "TotalIssuesAnalysed")
offsetDocRefDetailsRow = GetWorkbookNameValueAsLong(logWb, "TotalRefsAnalysed")
offsetDocIssuesRow = GetWorkbookNameValueAsLong(logWb, getAppSpecificApplicationName & "_" & "TotalDocsAnalysedWithIssues")
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : offsetDocPropRow " & offsetDocPropRow & _
@@ -2601,13 +2601,13 @@ Sub WriteToIni(key As String, value As String)
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "WriteToIni"
-
+
If mIniFilePath = "" Then Exit Sub
Call WritePrivateProfileString("Analysis", key, value, mIniFilePath)
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : key " & key & " : value " & value & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2617,16 +2617,16 @@ Sub WriteToLog(key As String, value As String)
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "WriteToLog"
-
+
If mLogFilePath = "" Then Exit Sub
-
+
Dim sSection As String
sSection = getAppSpecificApplicationName
-
+
Call WritePrivateProfileString(sSection, key, value, mLogFilePath)
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : key " & key & " : value " & value & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2634,12 +2634,12 @@ End Sub
Sub WriteDebug(value As String)
On Error Resume Next 'Ignore errors in our error writing routines - could get circular dependency otherwise
Static ErrCount As Long
-
+
If mLogFilePath = "" Then Exit Sub
-
+
Dim sSection As String
sSection = getAppSpecificApplicationName & "Debug"
-
+
If mDebugLevel > 0 Then
Call WritePrivateProfileString(sSection, "Doc" & mDocIndex & "_debug" & ErrCount, value, mLogFilePath)
ErrCount = ErrCount + 1
@@ -2650,12 +2650,12 @@ End Sub
Sub WriteDebugLevelTwo(value As String)
On Error Resume Next 'Ignore errors in our error writing routines - could get circular dependency otherwise
Static ErrCountTwo As Long
-
+
If mLogFilePath = "" Then Exit Sub
-
+
Dim sSection As String
sSection = getAppSpecificApplicationName & "Debug"
-
+
If mDebugLevel > 1 Then
Call WritePrivateProfileString(sSection, "Doc" & mDocIndex & "_debug" & ErrCountTwo, "Level2: " & value, mLogFilePath)
ErrCountTwo = ErrCountTwo + 1
@@ -2676,15 +2676,15 @@ Public Function ProfileLoadDict(dict As Scripting.Dictionary, _
Dim KeyData As String
Dim lpKeyName As String
Dim ret As String
-
+
ret = Space$(2048)
nSize = Len(ret)
success = GetPrivateProfileString( _
lpSectionName, vbNullString, "", ret, nSize, inifile)
-
+
If success Then
ret = Left$(ret, success)
-
+
Do Until ret = ""
lpKeyName = StripNulls(ret)
KeyData = ProfileGetItem( _
@@ -2695,7 +2695,7 @@ Public Function ProfileLoadDict(dict As Scripting.Dictionary, _
ProfileLoadDict = dict.count
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : dict.Count " & dict.count & _
@@ -2710,20 +2710,20 @@ Private Function StripNulls(startStrg As String) As String
currentFunctionName = "StripNulls"
Dim pos As Long
Dim item As String
-
+
pos = InStr(1, startStrg, Chr$(0))
-
+
If pos Then
-
+
item = Mid$(startStrg, 1, pos - 1)
startStrg = Mid$(startStrg, pos + 1, Len(startStrg))
StripNulls = item
-
+
End If
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : startStrg " & startStrg & " : " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2736,7 +2736,7 @@ Public Function ProfileGetItem(lpSectionName As String, _
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "ProfileGetItem"
-
+
Dim success As Long
Dim nSize As Long
Dim ret As String
@@ -2753,10 +2753,10 @@ Public Function ProfileGetItem(lpSectionName As String, _
Else
ProfileGetItem = defaultValue
End If
-
+
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : lpSectionName " & lpSectionName & _
@@ -2771,9 +2771,9 @@ Public Function GetDefaultPassword() As String
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "GetDefaultPassword"
-
+
Static myPassword As String
-
+
If myPassword = "" Then
myPassword = ProfileGetItem("Analysis", CDEFAULT_PASSWORD, "", mIniFilePath)
End If
@@ -2781,7 +2781,7 @@ Public Function GetDefaultPassword() As String
GetDefaultPassword = myPassword
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2791,7 +2791,7 @@ Public Function GetVersion() As String
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "GetVersion"
-
+
Static myVersion As String
If myVersion = "" Then
@@ -2801,7 +2801,7 @@ Public Function GetVersion() As String
GetVersion = myVersion
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2810,7 +2810,7 @@ Public Function GetTitle() As String
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "GetTitle"
-
+
Static myTitle As String
If myTitle = "" Then
@@ -2820,7 +2820,7 @@ Public Function GetTitle() As String
GetTitle = myTitle
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2851,7 +2851,7 @@ Function CheckForAbort() As Boolean
On Error GoTo HandleErrors
bAbort = CBool(ProfileGetItem("Analysis", C_ABORT_ANALYSIS, "false", mIniFilePath))
-
+
'reset the flag
If (bAbort) Then Call WriteToIni(C_ABORT_ANALYSIS, "false")
@@ -2868,7 +2868,7 @@ Function CheckDoPrepare() As Boolean
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "CheckDoPrepare"
-
+
Static bDoPrepare As Boolean
Static myDoPrepare As String
@@ -2881,7 +2881,7 @@ Function CheckDoPrepare() As Boolean
CheckDoPrepare = bDoPrepare
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2890,9 +2890,9 @@ End Function
Function GetIssuesLimitInDays() As Long
On Error GoTo HandleErrors
Dim currentFunctionName As String
-
+
currentFunctionName = "GetIssuesLimitInDays"
-
+
Static issuesLimit As Long
Static myDoPrepare As String
@@ -2904,7 +2904,7 @@ Function GetIssuesLimitInDays() As Long
GetIssuesLimitInDays = issuesLimit
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2915,7 +2915,7 @@ Public Sub AddIssueDetailsNote(myIssue As IssueInfo, noteNum As Long, noteStr As
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "AddIssueDetailsNote"
-
+
If IsMissing(preStr) Then
preStr = RID_STR_COMMON_NOTE_PRE
End If
@@ -2924,7 +2924,7 @@ Public Sub AddIssueDetailsNote(myIssue As IssueInfo, noteNum As Long, noteStr As
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : noteNum " & noteNum & " : noteStr " & noteStr & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2938,11 +2938,11 @@ Public Sub SetupWizardVariables( _
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "SetupWizardVariables"
-
+
If mIniFilePath = "" Then
mIniFilePath = GetAppDataFolder & "\Sun\AnalysisWizard\" & CWIZARD & ".ini"
End If
-
+
statFileName = ProfileGetItem("Analysis", CSTAT_FILE, "", mIniFilePath)
fileList = ProfileGetItem("Analysis", CFILE_LIST, "", mIniFilePath)
storeToDir = ProfileGetItem("Analysis", COUTPUT_DIR, "", mIniFilePath)
@@ -2957,7 +2957,7 @@ Public Sub SetupWizardVariables( _
singleFile = ProfileGetItem("Analysis", CSINGLE_FILE, "", mIniFilePath)
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & _
": mIniFilePath " & mIniFilePath & ": " & _
@@ -2969,7 +2969,7 @@ Public Sub SetupSearchTypes(searchTypes As Collection)
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "SetupSearchTypes"
-
+
Dim bDocument As Boolean
Dim bTemplate As Boolean
@@ -2979,7 +2979,7 @@ Public Sub SetupSearchTypes(searchTypes As Collection)
If bTemplate = True Then searchTypes.Add "*" & getAppSpecificTemplateExt
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & ": searchTypes.Count " & searchTypes.count & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -2989,13 +2989,13 @@ Sub WriteXMLHeader(out As TextStream)
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "WriteXMLHeader"
-
+
out.WriteLine "<?xml version=""1.0"" encoding=""ISO-8859-1""?>"
out.WriteLine "<!DOCTYPE results SYSTEM 'analysis.dtd'>"
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -3004,14 +3004,14 @@ Sub WriteXMLResultsStartTag(out As TextStream)
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "WriteXMLResultsStartTag"
-
+
out.WriteLine "<results generated-by=""" & IIf(InDocPreparation, "documentanalysis_preparation", "documentanalysis") & """"
out.WriteLine " version=""" & GetVersion & """ timestamp=""" & Now & """"
out.WriteLine " type=""" & getAppSpecificApplicationName & """ >"
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -3020,12 +3020,12 @@ Sub WriteXMLResultsEndTag(out As TextStream)
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "WriteXMLResultsEndTag"
-
+
out.WriteLine "</results>"
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -3035,7 +3035,7 @@ Sub WriteXMLDocProperties(out As TextStream, aAnalysis As DocumentAnalysis)
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "WriteXMLDocProperties"
-
+
out.WriteLine "<document location=""" & EncodeXML(aAnalysis.name) & """"
out.WriteLine " application=""" & aAnalysis.Application & """"
out.WriteLine " issues-count=""" & (aAnalysis.IssuesCount) & """"
@@ -3051,7 +3051,7 @@ Sub WriteXMLDocProperties(out As TextStream, aAnalysis As DocumentAnalysis)
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -3061,12 +3061,12 @@ Sub WriteXMLDocPropertiesEndTag(out As TextStream)
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "WriteXMLDocPropertiesEndTag"
-
+
out.WriteLine "</document>"
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -3077,7 +3077,7 @@ Sub WriteXMLDocRefDetails(out As TextStream, aAnalysis As DocumentAnalysis)
Dim currentFunctionName As String
currentFunctionName = "WriteXMLDocRefDetails"
Dim myIssue As IssueInfo
-
+
'Output References for Docs with Macros
If aAnalysis.HasMacros And (aAnalysis.References.count > 0) Then
out.WriteLine "<references>"
@@ -3086,10 +3086,10 @@ Sub WriteXMLDocRefDetails(out As TextStream, aAnalysis As DocumentAnalysis)
Next myIssue
out.WriteLine "</references>"
End If
-
+
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -3100,15 +3100,15 @@ Sub OutputXMLReferenceAttributes(out As TextStream, aAnalysis As DocumentAnalysi
Dim currentFunctionName As String
currentFunctionName = "OutputXMLReferenceAttributes"
Dim strAttributes As String
-
+
With myIssue
out.WriteLine "<reference"
-
+
strAttributes = .Values("Major") & "." & .Values("Minor")
strAttributes = IIf(strAttributes = "0.0" Or strAttributes = ".", .Values("Name"), _
.Values("Name") & " " & .Values("Major") & "." & .Values("Minor"))
out.WriteLine " name=""" & EncodeXML(strAttributes) & """"
-
+
If .Values("Type") = "Project" Then
strAttributes = "Project reference"
Else
@@ -3123,13 +3123,13 @@ Sub OutputXMLReferenceAttributes(out As TextStream, aAnalysis As DocumentAnalysi
out.WriteLine " GUID=""" & strAttributes & """"
out.WriteLine " is-broken=""" & .Values("IsBroken") & """"
out.WriteLine " builtin=""" & .Values("BuiltIn") & """"
-
+
out.WriteLine " />"
End With
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : path " & aAnalysis.name & " : myIssue " & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -3139,11 +3139,11 @@ Sub WriteXMLDocIssueDetails(out As TextStream, aAnalysis As DocumentAnalysis)
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "WriteXMLDocIssueDetails"
-
+
Dim myIssue As IssueInfo
-
+
If aAnalysis.Issues.count = 0 Then Exit Sub
-
+
out.WriteLine "<issues>"
For Each myIssue In aAnalysis.Issues
OutputXMLCommonIssueDetails out, aAnalysis, myIssue
@@ -3151,10 +3151,10 @@ Sub WriteXMLDocIssueDetails(out As TextStream, aAnalysis As DocumentAnalysis)
out.WriteLine "</issue>"
Next myIssue
out.WriteLine "</issues>"
-
+
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -3164,16 +3164,16 @@ Sub OutputXMLCommonIssueDetails(out As TextStream, aAnalysis As DocumentAnalysis
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "OutputXMLCommonIssueDetails"
-
+
out.WriteLine "<issue category=""" & myIssue.IssueTypeXML & """"
out.WriteLine " type=""" & myIssue.SubTypeXML & """"
-
+
'NOTE: Dropping severity - now stored in results.xlt, do not want to open it to fetch this data
'out.WriteLine " severity=""" & IIf(CheckForMinorIssue(aAnalysis, myIssue), "Minor", "Major") & """"
out.WriteLine " prepared=""" & IIf((myIssue.Preparable), "True", "False") & """ >"
-
+
out.WriteLine "<location type=""" & myIssue.locationXML & """ >"
-
+
If myIssue.SubLocation <> "" Then
out.WriteLine "<property name=""sublocation"" value=""" & myIssue.SubLocation & """ />"
End If
@@ -3184,10 +3184,10 @@ Sub OutputXMLCommonIssueDetails(out As TextStream, aAnalysis As DocumentAnalysis
out.WriteLine "<property name=""column"" value=""" & myIssue.column & """ />"
End If
out.WriteLine "</location>"
-
+
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : path " & aAnalysis.name & " : myIssue " & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -3197,13 +3197,13 @@ Sub OutputXMLCommonIssueAttributes(out As TextStream, myIssue As IssueInfo)
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "OutputXMLCommonIssueAttributes"
-
+
Dim index As Integer
Dim valStr As String
Dim attStr As String
-
+
If myIssue.Attributes.count = 0 Then Exit Sub
-
+
out.WriteLine "<details>"
For index = 1 To myIssue.Attributes.count
attStr = myIssue.Attributes(index)
@@ -3215,12 +3215,12 @@ Sub OutputXMLCommonIssueAttributes(out As TextStream, myIssue As IssueInfo)
out.WriteLine "<property name=""" & EncodeXML(myIssue.Attributes(index)) & """ value=""" & EncodeXML(myIssue.Values(index)) & """ />"
End If
Next index
-
+
out.WriteLine "</details>"
-
+
FinalExit:
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : myIssue " & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -3230,26 +3230,26 @@ End Sub
Sub WriteXMLOutput(storeToDir As String, resultsFile As String, _
bOverwriteResultsFile As Boolean, bNewResultsFile As Boolean, AnalysedDocs As Collection, _
fso As Scripting.FileSystemObject)
-
+
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "WriteXMLOutput"
-
+
Dim xmlOutput As TextStream
Dim xmlOrigOutput As TextStream
Dim origOutput As String
Dim analysis As DocumentAnalysis
Dim outFilePath As String
-
+
outFilePath = storeToDir & "\" & fso.GetBaseName(resultsFile) & "_" & _
getAppSpecificApplicationName & ".xml"
Set xmlOutput = fso.CreateTextFile(outFilePath, True)
WriteXMLHeader xmlOutput
-
+
'Set xmlOrigOutput = fso.OpenTextFile(outFilePath, ForReading)
'Set xmlOutput = fso.OpenTextFile(outFilePath, ForWriting)
-
+
WriteXMLResultsStartTag xmlOutput
For Each analysis In AnalysedDocs
WriteXMLDocProperties xmlOutput, analysis
@@ -3258,12 +3258,12 @@ Sub WriteXMLOutput(storeToDir As String, resultsFile As String, _
WriteXMLDocPropertiesEndTag xmlOutput
Next analysis
WriteXMLResultsEndTag xmlOutput
-
+
FinalExit:
xmlOutput.Close
Set xmlOutput = Nothing
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : path " & outFilePath & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -3276,30 +3276,30 @@ Private Function EncodeUrl(ByVal sUrl As String) As String
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "EncodeUrl"
-
+
Dim sUrlEsc As String
Dim dwSize As Long
Dim dwFlags As Long
-
+
If Len(sUrl) > 0 Then
-
+
sUrlEsc = Space$(MAX_PATH)
dwSize = Len(sUrlEsc)
dwFlags = URL_DONT_SIMPLIFY
-
+
If UrlEscape(sUrl, _
sUrlEsc, _
dwSize, _
dwFlags) = ERROR_SUCCESS Then
-
+
EncodeUrl = Left$(sUrlEsc, dwSize)
-
+
End If 'If UrlEscape
End If 'If Len(sUrl) > 0
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : sUrl " & sUrl & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -3309,7 +3309,7 @@ Private Function EncodeXML(Str As String) As String
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "EncodeXML"
-
+
Str = Replace(Str, "^", "^")
Str = Replace(Str, "&", "&")
Str = Replace(Str, "`", "'")
@@ -3321,17 +3321,17 @@ Private Function EncodeXML(Str As String) As String
Str = Replace(Str, """", """)
Str = Replace(Str, "<", "<")
Str = Replace(Str, ">", ">")
-
+
'str = Replace(str, "\", "\")
'str = Replace(str, "#", "#")
'str = Replace(str, "?", "?")
'str = Replace(str, "/", "/")
EncodeXML = Str
-
+
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : string " & Str & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -3342,10 +3342,10 @@ Function ReplaceTopicTokens(sString As String, _
sToken As String, _
sReplacement As String) As String
On Error Resume Next
-
+
Dim p As Integer
Dim sTmp As String
-
+
sTmp = sString
Do
p = InStr(sTmp, sToken)
@@ -3353,10 +3353,10 @@ Function ReplaceTopicTokens(sString As String, _
sTmp = Left(sTmp, p - 1) + sReplacement + Mid(sTmp, p + Len(sToken))
End If
Loop While p > 0
-
-
+
+
ReplaceTopicTokens = sTmp
-
+
End Function
Function ReplaceTopic2Tokens(sString As String, _
@@ -3365,7 +3365,7 @@ Function ReplaceTopic2Tokens(sString As String, _
sToken2 As String, _
sReplacement2 As String) As String
On Error Resume Next
-
+
ReplaceTopic2Tokens = _
ReplaceTopicTokens(ReplaceTopicTokens(sString, sToken1, sReplacement1), _
sToken2, sReplacement2)
@@ -3376,7 +3376,7 @@ Function GetResourceDataFileName(thisDir As String) As String
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "GetResourceDataFileName"
-
+
Dim fso As FileSystemObject
Set fso = New FileSystemObject
@@ -3389,9 +3389,9 @@ Function GetResourceDataFileName(thisDir As String) As String
Dim isoLangStr As String
Dim isoCountryStr As String
Dim langDir As String
-
+
langDir = thisDir & "\" & "lang"
-
+
Dim userLCID As Long
userLCID = GetUserDefaultLangID()
Dim sysLCID As Long
@@ -3399,7 +3399,7 @@ Function GetResourceDataFileName(thisDir As String) As String
isoLangStr = GetUserLocaleInfo(userLCID, LOCALE_SISO639LANGNAME)
isoCountryStr = GetUserLocaleInfo(userLCID, LOCALE_SISO3166CTRYNAME)
-
+
'check for locale data in following order:
' user language
' isoLangStr & "_" & isoCountryStr & ".dat"
@@ -3408,7 +3408,7 @@ Function GetResourceDataFileName(thisDir As String) As String
' isoLangStr & "_" & isoCountryStr & ".dat"
' isoLangStr & ".dat"
' "en_US" & ".dat"
-
+
If fso.FileExists(fso.GetAbsolutePathName(langDir & "\" & isoLangStr & "-" & isoCountryStr & ".dat")) Then
GetResourceDataFileName = fso.GetAbsolutePathName(langDir & "\" & isoLangStr & "-" & isoCountryStr & ".dat")
ElseIf fso.FileExists(fso.GetAbsolutePathName(langDir & "\" & isoLangStr & ".dat")) Then
@@ -3416,7 +3416,7 @@ Function GetResourceDataFileName(thisDir As String) As String
Else
isoLangStr = GetUserLocaleInfo(sysLCID, LOCALE_SISO639LANGNAME)
isoCountryStr = GetUserLocaleInfo(sysLCID, LOCALE_SISO3166CTRYNAME)
-
+
If fso.FileExists(fso.GetAbsolutePathName(langDir & "\" & isoLangStr & "-" & isoCountryStr & ".dat")) Then
GetResourceDataFileName = fso.GetAbsolutePathName(langDir & "\" & isoLangStr & "-" & isoCountryStr & ".dat")
ElseIf fso.FileExists(fso.GetAbsolutePathName(langDir & "\" & isoLangStr & ".dat")) Then
@@ -3428,7 +3428,7 @@ Function GetResourceDataFileName(thisDir As String) As String
FinalExit:
Set fso = Nothing
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -3440,20 +3440,20 @@ Public Function GetUserLocaleInfo(ByVal dwLocaleID As Long, ByVal dwLCType As Lo
currentFunctionName = "GetUserLocaleInfo"
Dim sReturn As String
Dim r As Long
-
+
'call the function passing the Locale type
'variable to retrieve the required size of
'the string buffer needed
r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
-
+
'if successful..
If r Then
'pad the buffer with spaces
sReturn = Space$(r)
-
+
'and call again passing the buffer
r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
-
+
'if successful (r > 0)
If r Then
'r holds the size of the string
@@ -3461,10 +3461,10 @@ Public Function GetUserLocaleInfo(ByVal dwLocaleID As Long, ByVal dwLCType As Lo
GetUserLocaleInfo = Left$(sReturn, r - 1)
End If
End If
-
+
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -3508,9 +3508,9 @@ Sub WriteToStatFile(statFileName As String, statValue As Integer, _
currDocument As String, fso As Scripting.FileSystemObject)
On Error Resume Next
-
+
Dim fileCont As TextStream
-
+
Set fileCont = fso.OpenTextFile(statFileName, ForWriting, True, TristateTrue)
If (statValue = C_STAT_STARTING) Then
fileCont.WriteLine ("analysing=" & currDocument)
@@ -3535,12 +3535,12 @@ Function FindIndex(myDocument As String, _
Dim curIndex As Long
Dim curEntry As String
Dim entryFound As Boolean
-
+
entryFound = False
lastEntry = myDocList.count
-
+
If (lastIndex > lastEntry) Then lastIndex = lastEntry
-
+
If (lastIndex > 1) Then
curIndex = lastIndex
Else
@@ -3567,7 +3567,7 @@ Function FindIndex(myDocument As String, _
End If
Wend
End If
-
+
If entryFound Then
FindIndex = curIndex
Else
@@ -3602,7 +3602,7 @@ Function GetIndexValues(startIndex As Long, nextCheck As Long, _
End If
nextCheck = FindIndex(nextFile, myFiles, startIndex - 1)
-
+
If (nextCheck = 0) Then ' Next file not in file list, restarting
startIndex = 1
nextCheck = C_MAX_CHECK
diff --git a/main/migrationanalysis/src/driver_docs/sources/CommonMigrationAnalyser.bas b/main/migrationanalysis/src/driver_docs/sources/CommonMigrationAnalyser.bas
index 280f7beed8..f3884cdd8d 100644
--- a/main/migrationanalysis/src/driver_docs/sources/CommonMigrationAnalyser.bas
+++ b/main/migrationanalysis/src/driver_docs/sources/CommonMigrationAnalyser.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "CommonMigrationAnalyser"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -90,7 +90,7 @@ Sub EmptyCollection(docAnalysis As DocumentAnalysis, coll As Collection)
coll.Remove 1 ' Default collection numeric indexes
Next ' begin at 1.
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
End Sub
@@ -109,7 +109,7 @@ Public Function Analyze_Macros(docAnalysis As DocumentAnalysis, _
Dim myIssue As IssueInfo
Dim wrd As Object
Dim bUserFormWithEmptyCodeModule As Boolean
-
+
On Error Resume Next
Set myProject = getAppSpecificVBProject(currDoc)
If Err.Number <> 0 Then
@@ -117,10 +117,10 @@ Public Function Analyze_Macros(docAnalysis As DocumentAnalysis, _
WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & _
RID_STR_COMMON_ATTRIBUTE_UNABLE_TO_ACCESS_VBPROJECT & ":" & _
RID_STR_COMMON_ATTRIBUTE_FURTHER_MACRO_ANALYSIS_NOT_POSSIBLE
-
+
GoTo FinalExit
End If
-
+
On Error GoTo HandleErrors
If myProject.Protection = vbext_pp_locked Then
Set myIssue = New IssueInfo
@@ -129,11 +129,11 @@ Public Function Analyze_Macros(docAnalysis As DocumentAnalysis, _
.IssueType = RID_STR_COMMON_ISSUE_VBA_MACROS
.SubType = RID_STR_COMMON_SUBISSUE_MACRO_PASSWORD_PROTECTION
.Location = .CLocationDocument
-
+
.IssueTypeXML = CSTR_ISSUE_VBA_MACROS
.SubTypeXML = CSTR_SUBISSUE_MACRO_PASSWORD_PROTECTION
.locationXML = .CXMLLocationDocument
-
+
.Attributes.Add RID_STR_COMMON_ATTRIBUTE_VBPROJECT_PASSWORD
.Values.Add RID_STR_COMMON_ATTRIBUTE_FURTHER_MACRO_ANALYSIS_NOT_POSSIBLE
End With
@@ -141,14 +141,14 @@ Public Function Analyze_Macros(docAnalysis As DocumentAnalysis, _
docAnalysis.IssuesCountArray(CID_VBA_MACROS) + 1
docAnalysis.Issues.Add myIssue
docAnalysis.MacroIssuesCount = docAnalysis.MacroIssuesCount + 1
-
+
docAnalysis.HasMacros = True
GoTo FinalExit
End If
Dim myContolDict As Scripting.Dictionary
For Each myComponent In myProject.VBComponents
-
+
bUserFormWithEmptyCodeModule = False
If CheckEmptyProject(docAnalysis, myProject, myComponent) Then
If myComponent.Type <> vbext_ct_MSForm Then
@@ -157,20 +157,20 @@ Public Function Analyze_Macros(docAnalysis As DocumentAnalysis, _
bUserFormWithEmptyCodeModule = True
End If
End If
-
+
Analyze_MacrosForPortabilityIssues docAnalysis, myProject, myComponent
-
+
Set myIssue = New IssueInfo
With myIssue
.IssueID = CID_VBA_MACROS
.IssueType = RID_STR_COMMON_ISSUE_VBA_MACROS
.SubType = RID_STR_COMMON_SUBISSUE_PROPERTIES
.Location = .CLocationDocument
-
+
.IssueTypeXML = CSTR_ISSUE_VBA_MACROS
.SubTypeXML = CSTR_SUBISSUE_PROPERTIES
.locationXML = .CXMLLocationDocument
-
+
.SubLocation = VBComponentType(myComponent)
.Attributes.Add RID_STR_COMMON_ATTRIBUTE_PROJECT
.Values.Add myProject.name
@@ -181,7 +181,7 @@ Public Function Analyze_Macros(docAnalysis As DocumentAnalysis, _
.Attributes.Add RID_STR_COMMON_ATTRIBUTE_NUMBER_OF_LINES
numLines = VBNumLines(docAnalysis, myComponent.CodeModule)
.Values.Add numLines, RID_STR_COMMON_ATTRIBUTE_NUMBER_OF_LINES
-
+
If bUserFormWithEmptyCodeModule Then
.Attributes.Add RID_STR_COMMON_ATTRIBUTE_SIGNATURE
.Values.Add RID_STR_COMMON_NA, RID_STR_COMMON_ATTRIBUTE_SIGNATURE
@@ -191,23 +191,23 @@ Public Function Analyze_Macros(docAnalysis As DocumentAnalysis, _
myComponent.CodeModule.Lines(1, myComponent.CodeModule.CountOfLines)), _
RID_STR_COMMON_ATTRIBUTE_SIGNATURE
End If
-
+
docAnalysis.MacroTotalNumLines = numLines + docAnalysis.MacroTotalNumLines
End With
-
+
' User Forms - control details
If (myComponent.Type = vbext_ct_MSForm) And Not bUserFormWithEmptyCodeModule Then
myIssue.Attributes.Add RID_STR_COMMON_ATTRIBUTE_CONTROLS
myIssue.Values.Add myComponent.Designer.Controls.count, RID_STR_COMMON_ATTRIBUTE_CONTROLS
docAnalysis.MacroNumUserForms = 1 + docAnalysis.MacroNumUserForms
docAnalysis.MacroNumUserFormControls = myComponent.Designer.Controls.count + docAnalysis.MacroNumUserFormControls
-
+
Dim myControl As Control
Dim controlTypes As String
Dim myType As String
-
+
Set myContolDict = New Scripting.Dictionary
-
+
For Each myControl In myComponent.Designer.Controls
myType = TypeName(myControl)
If myContolDict.Exists(myType) Then
@@ -221,34 +221,34 @@ Public Function Analyze_Macros(docAnalysis As DocumentAnalysis, _
userFormTypesDict.Add myType, 1
End If
Next
-
+
If myComponent.Designer.Controls.count > 0 Then
Dim count As Long
Dim vKeyArray As Variant
Dim vItemArray As Variant
-
+
vKeyArray = myContolDict.Keys
vItemArray = myContolDict.Items
-
+
controlTypes = ""
For count = 0 To myContolDict.count - 1
controlTypes = controlTypes & vKeyArray(count) & " " & CInt(vItemArray(count)) & " "
Next count
myIssue.Attributes.Add RID_STR_COMMON_ATTRIBUTE_USERFORM_TYPE
myIssue.Values.Add controlTypes, RID_STR_COMMON_ATTRIBUTE_USERFORM_TYPE
-
+
myIssue.Attributes.Add RID_STR_COMMON_ATTRIBUTE_USERFORM_TYPES_COUNT
myIssue.Values.Add myContolDict.count, RID_STR_COMMON_ATTRIBUTE_USERFORM_TYPES_COUNT
-
+
docAnalysis.MacroNumUserFormControlTypes = myContolDict.count + docAnalysis.MacroNumUserFormControlTypes
End If
Set myContolDict = Nothing
End If
-
+
'Check for occurrence of " Me " in Form and Class Modules
If myComponent.Type = vbext_ct_MSForm Or _
myComponent.Type = vbext_ct_ClassModule Then
-
+
Dim strFind As String
strFind = ""
count = 0
@@ -260,31 +260,31 @@ Public Function Analyze_Macros(docAnalysis As DocumentAnalysis, _
myIssue.Values.Add count, RID_STR_COMMON_ATTRIBUTE_CLASS_ME_COUNT
End If
End If
-
+
docAnalysis.IssuesCountArray(CID_VBA_MACROS) = _
docAnalysis.IssuesCountArray(CID_VBA_MACROS) + 1
docAnalysis.Issues.Add myIssue
docAnalysis.MacroIssuesCount = docAnalysis.MacroIssuesCount + 1
-
+
Set myIssue = Nothing
-
+
FOREACH_CONTINUE:
'No equiv to C continue in VB
Next myComponent 'End - For Each myComponent
-
+
If docAnalysis.IssuesCountArray(CID_VBA_MACROS) > 0 Then
Analyze_VBEReferences docAnalysis, currDoc
docAnalysis.HasMacros = True
End If
-
+
FinalExit:
docAnalysis.MacroOverallClass = ClassifyDocOverallMacroClass(docAnalysis)
-
+
Set myProject = Nothing
Set myIssue = Nothing
Set myContolDict = Nothing
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -304,13 +304,13 @@ Function CheckOnlyEmptyProject(docAnalysis As DocumentAnalysis, currDoc As Objec
GoTo FinalExit
End If
Next myVBComponent
-
+
CheckOnlyEmptyProject = True
FinalExit:
Set myProject = Nothing
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -325,23 +325,23 @@ Sub Analyze_VBEReferences(docAnalysis As DocumentAnalysis, currDoc As Object)
Dim fso As Scripting.FileSystemObject
Dim myVBProject As VBProject
Dim myVBComponent As VBComponent
-
+
Set fso = New Scripting.FileSystemObject
-
+
If CheckOnlyEmptyProject(docAnalysis, currDoc) Then
Exit Sub
End If
Set myVBProject = getAppSpecificVBProject(currDoc)
-
+
For Each Ref In myVBProject.References
Analyze_VBEReferenceSingle docAnalysis, Ref, fso
Next Ref
-
+
FinalExit:
Set myVBProject = Nothing
Set fso = Nothing
Exit Sub
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -354,18 +354,18 @@ Sub Analyze_VBEReferenceSingle(docAnalysis As DocumentAnalysis, Ref As Reference
'References
Dim myIssue As IssueInfo
Dim bBadRef As Boolean
-
+
Set myIssue = New IssueInfo
With myIssue
.IssueID = CID_INFORMATION_REFS
.IssueType = RID_STR_COMMON_ISSUE_INFORMATION
.SubType = RID_STR_COMMON_SUBISSUE_REFERENCES
.Location = .CLocationDocument
-
+
.IssueTypeXML = CSTR_ISSUE_INFORMATION
.SubTypeXML = CSTR_SUBISSUE_REFERENCES
.locationXML = .CXMLLocationDocument
-
+
If Ref.GUID = "" Then
bBadRef = True
Else
@@ -393,10 +393,10 @@ Sub Analyze_VBEReferenceSingle(docAnalysis As DocumentAnalysis, Ref As Reference
.Values.Add IIf(Not bBadRef, Ref.Major, ""), RID_STR_COMMON_ATTRIBUTE_MAJOR
.Attributes.Add RID_STR_COMMON_ATTRIBUTE_MINOR
.Values.Add IIf(Not bBadRef, Ref.Minor, ""), RID_STR_COMMON_ATTRIBUTE_MINOR
-
+
.Attributes.Add RID_STR_COMMON_ATTRIBUTE_TYPE
.Values.Add IIf(Ref.Type = vbext_rk_Project, RID_STR_COMMON_ATTRIBUTE_PROJECT, RID_STR_COMMON_ATTRIBUTE_TYPELIB), RID_STR_COMMON_ATTRIBUTE_TYPE
-
+
.Attributes.Add RID_STR_COMMON_ATTRIBUTE_BUILTIN
.Values.Add IIf(Ref.BuiltIn, RID_STR_COMMON_ATTRIBUTE_BUILTIN, RID_STR_COMMON_ATTRIBUTE_CUSTOM), RID_STR_COMMON_ATTRIBUTE_BUILTIN
.Attributes.Add RID_STR_COMMON_ATTRIBUTE_ISBROKEN
@@ -404,13 +404,13 @@ Sub Analyze_VBEReferenceSingle(docAnalysis As DocumentAnalysis, Ref As Reference
.Attributes.Add RID_STR_COMMON_ATTRIBUTE_GUID
.Values.Add IIf(Ref.Type = vbext_rk_TypeLib, Ref.GUID, ""), RID_STR_COMMON_ATTRIBUTE_GUID
End With
-
+
docAnalysis.References.Add myIssue
-
+
FinalExit:
Set myIssue = Nothing
Exit Sub
-
+
HandleErrors:
WriteDebugLevelTwo currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -422,7 +422,7 @@ Sub Analyze_MacrosForPortabilityIssues(docAnalysis As DocumentAnalysis, myProjec
currentFunctionName = "Analyze_MacrosForPortabilityIssues"
Dim myIssue As IssueInfo
Dim count As Long
-
+
' Code Modules
Dim strFind As String
strFind = VBFindLines(docAnalysis, myComponent.CodeModule, "CreateObject", count, bWholeWord:=True) & _
@@ -435,7 +435,7 @@ Sub Analyze_MacrosForPortabilityIssues(docAnalysis As DocumentAnalysis, myProjec
VBFindLines(docAnalysis, myComponent.CodeModule, "Declare Function ", count, False) & _
VBFindLines(docAnalysis, myComponent.CodeModule, "Declare Sub ", count, False)
-
+
If (strFind <> "") And (myComponent.Type <> vbext_ct_Document) Then
Set myIssue = New IssueInfo
With myIssue
@@ -465,12 +465,12 @@ Sub Analyze_MacrosForPortabilityIssues(docAnalysis As DocumentAnalysis, myProjec
docAnalysis.MacroNumExternalRefs = count + docAnalysis.MacroNumExternalRefs
docAnalysis.MacroIssuesCount = docAnalysis.MacroIssuesCount + 1
End If
-
+
FinalExit:
Set myIssue = Nothing
Exit Sub
-
-
+
+
HandleErrors:
WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -503,16 +503,16 @@ Function VBFindLines(docAnalysis As DocumentAnalysis, vbcm As CodeModule, strFin
Dim lngType As Long
Dim strProc As String
Dim retStr As String
-
+
' Search
Do While vbcm.Find(strFind, lngStartLine, _
lngStartCol, lngEndLine, lngEndCol, bWholeWord, bMatchCase)
-
+
'Ignore any lines using this func
If InStr(1, vbcm.Lines(lngStartLine, 1), "VBFindLines") <> 0 Then
GoTo CONTINUE_LOOP
End If
-
+
If bInProcedure Then
If bUsingNew Then
If InStr(1, vbcm.Lines(lngStartLine, 1), "New") <> 0 Then
@@ -524,13 +524,13 @@ Function VBFindLines(docAnalysis As DocumentAnalysis, vbcm As CodeModule, strFin
strProc = vbcm.ProcOfLine(lngStartLine, lngType)
End If
If strProc = "" Then GoTo CONTINUE_LOOP
-
+
VBFindLines = VBFindLines & "[" & strProc & " ( ) - " & lngStartLine & " ]" & _
vbLf & vbcm.Lines(lngStartLine, 1) & vbLf
Else
strProc = vbcm.Lines(lngStartLine, 1)
If strProc = "" Then GoTo CONTINUE_LOOP
-
+
'Can be External refs, Const, Type or variable declarations
If InStr(1, vbcm.Lines(lngStartLine, 1), "Declare Function") <> 0 Then
VBFindLines = VBFindLines & "[" & RID_STR_COMMON_DEC_TO_EXTERNAL_LIBRARY & " - " & lngStartLine & " ]" & _
@@ -541,20 +541,20 @@ Function VBFindLines(docAnalysis As DocumentAnalysis, vbcm As CodeModule, strFin
End If
End If
count = count + 1
-
+
CONTINUE_LOOP:
'Reset Params to search for next hit
lngStartLine = lngEndLine + 1
lngStartCol = 1
lngEndLine = vbcm.CountOfLines
lngEndCol = Len(vbcm.Lines(vbcm.CountOfLines, 1))
-
+
If lngStartLine >= lngEndLine Then Exit Function
-
+
Loop 'End - Do While vbcm.Find
VBFindLines = VBFindLines
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
End Function
@@ -565,10 +565,10 @@ Function VBNumLines(docAnalysis As DocumentAnalysis, vbcm As CodeModule) As Long
Dim cLines As Long
Dim lngType As Long
Dim strProc As String
-
+
'Issue: Just give line count in module to be in sync with Macro Analysis and Migration Wizard
VBNumLines = vbcm.CountOfLines
-
+
'For cLines = 1 To vbcm.CountOfLines
' strProc = vbcm.ProcOfLine(cLines, lngType)
' If strProc <> "" Then
@@ -578,7 +578,7 @@ Function VBNumLines(docAnalysis As DocumentAnalysis, vbcm As CodeModule) As Long
' End If
'Next
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
End Function
@@ -589,7 +589,7 @@ Function VBNumFuncs(docAnalysis As DocumentAnalysis, vbcm As CodeModule) As Long
Dim cLines As Long
Dim lngType As Long
Dim strProc As String
-
+
For cLines = 1 To vbcm.CountOfLines
strProc = vbcm.ProcOfLine(cLines, lngType)
If strProc <> "" Then
@@ -624,14 +624,14 @@ Function CheckEmptyProject(docAnalysis As DocumentAnalysis, myProject As VBProje
Dim currentFunctionName As String
currentFunctionName = "CheckEmptyProject"
Dim bEmptyProject As Boolean
-
+
'Bug: Can have empty project with different name from default, would be picked up
' as not empty.
'bEmptyProject = _
' (StrComp(myProject.name, CTOPLEVEL_PROJECT) = 0) And _
' (VBNumFuncs(docAnalysis, myComponent.CodeModule) = 0) And _
' (VBNumLines(docAnalysis, myComponent.CodeModule) < 3)
-
+
' Code Modules
Dim strFind As String
Dim count As Long
@@ -641,12 +641,12 @@ Function CheckEmptyProject(docAnalysis As DocumentAnalysis, myProject As VBProje
'Public myVar As ...
strFind = VBFindLines(docAnalysis, myComponent.CodeModule, "Public", _
count, bInProcedure:=False, bWholeWord:=True, bMatchCase:=True)
-
+
bEmptyProject = _
(VBNumFuncs(docAnalysis, myComponent.CodeModule) = 0) And _
(VBNumLines(docAnalysis, myComponent.CodeModule) < 3) And _
(strFind = "")
-
+
CheckEmptyProject = IIf(bEmptyProject, True, False)
Exit Function
@@ -672,7 +672,7 @@ Function getCustomDocPropTypeAsString(propType As MsoDocProperties)
Case Else
Str = "Unknown"
End Select
-
+
getCustomDocPropTypeAsString = Str
End Function
@@ -738,13 +738,13 @@ Sub Analyze_OLEEmbeddedSingleShape(docAnalysis As DocumentAnalysis, aShape As Sh
Dim TypeAsString As String
Dim XMLTypeAsString As String
Dim objName As String
-
+
bOleObject = (aShape.Type = msoEmbeddedOLEObject) Or _
(aShape.Type = msoLinkedOLEObject) Or _
(aShape.Type = msoOLEControlObject)
-
+
If Not bOleObject Then Exit Sub
-
+
aShape.Select
Select Case aShape.Type
Case msoEmbeddedOLEObject
@@ -760,10 +760,10 @@ Sub Analyze_OLEEmbeddedSingleShape(docAnalysis As DocumentAnalysis, aShape As Sh
TypeAsString = RID_STR_COMMON_OLE_UNKNOWN
XMLTypeAsString = CSTR_SUBISSUE_OLE_UNKNOWN
End Select
-
+
Dim appStr As String
appStr = getAppSpecificApplicationName
-
+
Set myIssue = New IssueInfo
With myIssue
.IssueID = CID_PORTABILITY
@@ -771,11 +771,11 @@ Sub Analyze_OLEEmbeddedSingleShape(docAnalysis As DocumentAnalysis, aShape As Sh
.SubType = TypeAsString
.Location = .CLocationPage
.SubLocation = mySubLocation
-
+
.IssueTypeXML = CSTR_ISSUE_PORTABILITY
.SubTypeXML = XMLTypeAsString
.locationXML = .CXMLLocationPage
-
+
.Line = aShape.top
.column = aShape.Left
@@ -783,22 +783,22 @@ Sub Analyze_OLEEmbeddedSingleShape(docAnalysis As DocumentAnalysis, aShape As Sh
.Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME
.Values.Add aShape.name
End If
-
+
If aShape.Type = msoEmbeddedOLEObject Or _
aShape.Type = msoOLEControlObject Then
Dim objType As String
On Error Resume Next
-
+
objType = getAppSpecificOLEClassType(aShape)
-
+
If objType = "" Then GoTo FinalExit
.Attributes.Add RID_STR_COMMON_ATTRIBUTE_OBJECT_TYPE
.Values.Add objType
-
+
If aShape.Type = msoOLEControlObject Then
docAnalysis.MacroNumOLEControls = 1 + docAnalysis.MacroNumOLEControls
End If
-
+
If appStr = CAPPNAME_POWERPOINT Then
'#114127: Too many open windows
'Checking for OLEFormat.Object is Nothing or IsEmpty still causes problem
@@ -822,10 +822,10 @@ Sub Analyze_OLEEmbeddedSingleShape(docAnalysis As DocumentAnalysis, aShape As Sh
End If
End If
End If
-
+
On Error GoTo HandleErrors
End If
-
+
If aShape.Type = msoLinkedOLEObject Then
If appStr <> CAPPNAME_WORD Then
On Error Resume Next
@@ -841,16 +841,16 @@ Sub Analyze_OLEEmbeddedSingleShape(docAnalysis As DocumentAnalysis, aShape As Sh
.Values.Add aShape.LinkFormat.SourceFullName
End If
End If
-
+
docAnalysis.IssuesCountArray(CID_PORTABILITY) = _
docAnalysis.IssuesCountArray(CID_PORTABILITY) + 1
End With
docAnalysis.Issues.Add myIssue
-
+
FinalExit:
Set myIssue = Nothing
Exit Sub
-
+
HandleErrors:
WriteDebugLevelTwo currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -873,11 +873,11 @@ Sub Analyze_Lines(docAnalysis As DocumentAnalysis, myShape As Shape, mySubLocati
.SubType = RID_RESXLS_COST_LineStyle
.Location = .CLocationPage
.SubLocation = mySubLocation
-
+
.IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
.SubTypeXML = CSTR_SUBISSUE_LINE
.locationXML = .CXMLLocationPage
-
+
.Line = myShape.top
.column = myShape.Left
@@ -891,9 +891,9 @@ Sub Analyze_Lines(docAnalysis As DocumentAnalysis, myShape As Shape, mySubLocati
docAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _
docAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1
End With
-
+
docAnalysis.Issues.Add myIssue
-
+
FinalExit:
Set myIssue = Nothing
Exit Sub
@@ -919,24 +919,24 @@ Sub Analyze_Transparency(docAnalysis As DocumentAnalysis, myShape As Shape, mySu
bHasTransparentBkg = True
End If
End If
-
+
On Error GoTo HandleErrors
If Not bHasTransparentBkg Then Exit Sub
Dim myIssue As IssueInfo
Set myIssue = New IssueInfo
-
+
With myIssue
.IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES
.IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES
.SubType = RID_RESXLS_COST_Transparent
.Location = .CLocationSlide
.SubLocation = mySubLocation
-
+
.IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
.SubTypeXML = CSTR_SUBISSUE_TRANSPARENCY
.locationXML = .CXMLLocationPage
-
+
.Line = myShape.top
.column = myShape.Left
@@ -950,9 +950,9 @@ Sub Analyze_Transparency(docAnalysis As DocumentAnalysis, myShape As Shape, mySu
docAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _
docAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1
End With
-
+
docAnalysis.Issues.Add myIssue
-
+
FinalExit:
Set myIssue = Nothing
Exit Sub
@@ -968,7 +968,7 @@ Sub Analyze_Gradients(docAnalysis As DocumentAnalysis, myShape As Shape, mySubLo
currentFunctionName = "Analyze_Gradients"
If myShape.Fill.Type <> msoFillGradient Then Exit Sub
-
+
Dim bUsesPresetGradient, bUsesFromCorner, bUsesFromCenter
bUsesPresetGradient = False
bUsesFromCorner = False
@@ -990,25 +990,25 @@ Sub Analyze_Gradients(docAnalysis As DocumentAnalysis, myShape As Shape, mySubLo
bUsesFromCenter = True
End If
End If
-
+
On Error GoTo HandleErrors
If Not bUsesPresetGradient And Not bUsesFromCorner _
And Not bUsesFromCenter Then Exit Sub
Dim myIssue As IssueInfo
Set myIssue = New IssueInfo
-
+
With myIssue
.IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES
.IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES
.SubType = RID_RESXLS_COST_GradientStyle
.Location = .CLocationSlide
.SubLocation = mySubLocation
-
+
.IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
.SubTypeXML = CSTR_SUBISSUE_GRADIENT
.locationXML = .CXMLLocationSlide
-
+
.Line = myShape.top
.column = myShape.Left
@@ -1028,9 +1028,9 @@ Sub Analyze_Gradients(docAnalysis As DocumentAnalysis, myShape As Shape, mySubLo
docAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _
docAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1
End With
-
+
docAnalysis.Issues.Add myIssue
-
+
FinalExit:
Set myIssue = Nothing
Exit Sub
@@ -1064,28 +1064,28 @@ Function GetPreparedFullPath(sourceDocPath As String, startDir As String, storeT
GetPreparedFullPath = ""
Dim preparedPath As String
-
+
preparedPath = Right(sourceDocPath, Len(sourceDocPath) - Len(startDir))
If Left(preparedPath, 1) = "\" Then
preparedPath = Right(preparedPath, Len(preparedPath) - 1)
End If
-
+
'Allow for root folder C:\
If Right(storeToDir, 1) <> "\" Then
preparedPath = storeToDir & "\" & CSTR_COMMON_PREPARATION_FOLDER & "\" & preparedPath
Else
preparedPath = storeToDir & CSTR_COMMON_PREPARATION_FOLDER & "\" & preparedPath
End If
-
+
'Debug: MsgBox "Preppath: " & preparedPath
CreateFullPath fso.GetParentFolderName(preparedPath), fso
'Only set if folder to save to exists or has been created, otherwise return ""
GetPreparedFullPath = preparedPath
-
+
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebugLevelTwo currentFunctionName & " : " & sourceDocPath & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -1093,9 +1093,9 @@ End Function
Function ClassifyDocOverallMacroClass(docAnalysis As DocumentAnalysis) As EnumDocOverallMacroClass
ClassifyDocOverallMacroClass = enMacroNone
-
+
If Not docAnalysis.HasMacros Then Exit Function
-
+
If (docAnalysis.MacroTotalNumLines >= CMACRO_LINECOUNT_MEDIUM_LBOUND) Then
If (docAnalysis.MacroNumExternalRefs > 0) Or _
(docAnalysis.MacroNumOLEControls > 0 Or docAnalysis.MacroNumFieldsUsingMacros > 0) Or _
@@ -1107,6 +1107,5 @@ Function ClassifyDocOverallMacroClass(docAnalysis As DocumentAnalysis) As EnumDo
Else
ClassifyDocOverallMacroClass = enMacroSimple
End If
-
-End Function
+End Function
diff --git a/main/migrationanalysis/src/driver_docs/sources/CommonPreparation.bas b/main/migrationanalysis/src/driver_docs/sources/CommonPreparation.bas
index ae3ec562ec..c947520260 100644
--- a/main/migrationanalysis/src/driver_docs/sources/CommonPreparation.bas
+++ b/main/migrationanalysis/src/driver_docs/sources/CommonPreparation.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "CommonPreparation"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -40,7 +40,7 @@ Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long,
Private Declare Function CryptGetHashParam Lib "advapi32.dll" ( _
ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, _
pdwDataLen As Long, ByVal dwFlags As Long) As Long
-
+
Private Const ALG_CLASS_ANY As Long = 0
Private Const ALG_TYPE_ANY As Long = 0
Private Const ALG_CLASS_HASH As Long = 32768
@@ -60,31 +60,31 @@ Function DoPreparation(docAnalysis As DocumentAnalysis, myIssue As IssueInfo, pr
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "DoPreparation"
-
+
DoPreparation = False
-
+
'Log as Preparable
AddIssueDetailsNote myIssue, 0, preparationNote, RID_STR_COMMON_PREPARATION_NOTE
myIssue.Preparable = True
docAnalysis.PreparableIssuesCount = docAnalysis.PreparableIssuesCount + 1
-
+
If Not CheckDoPrepare Then Exit Function
-
+
'Do Prepare
If myIssue.IssueTypeXML = CSTR_ISSUE_OBJECTS_GRAPHICS_AND_FRAMES And _
myIssue.SubTypeXML = CSTR_SUBISSUE_OBJECT_IN_HEADER_FOOTER Then
DoPreparation = Prepare_HeaderFooter_GraphicFrames(docAnalysis, myIssue, var, currDoc)
-
+
ElseIf myIssue.IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES And _
myIssue.SubTypeXML = CSTR_SUBISSUE_OLD_WORKBOOK_VERSION Then
DoPreparation = Prepare_WorkbookVersion()
-
+
End If
-
+
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & _
" : path " & docAnalysis.name & ": " & _
@@ -102,33 +102,33 @@ Function Prepare_DocumentCustomProperties(docAnalysis As DocumentAnalysis, myIss
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "Prepare_DocumentCustomProperties"
-
+
Dim aProp As DocumentProperty
Dim myCustomDocumentProperties As DocumentProperties
Dim commentProp As DocumentProperty
Prepare_DocumentCustomProperties = False
-
+
Set myCustomDocumentProperties = getAppSpecificCustomDocProperties(currDoc)
Set commentProp = getAppSpecificCommentBuiltInDocProperty(currDoc)
Set aProp = var 'Safe as we know that a DocumentProperty is being passed in
-
+
If commentProp.value <> "" Then commentProp.value = commentProp.value & vbLf
commentProp.value = commentProp.value & _
RID_STR_COMMON_SUBISSUE_DOCUMENT_CUSTOM_PROPERTY & ": " & vbLf
-
+
commentProp.value = commentProp.value & _
RID_STR_COMMON_ATTRIBUTE_NAME & " - " & aProp.name & ", " & _
RID_STR_COMMON_ATTRIBUTE_TYPE & " - " & getCustomDocPropTypeAsString(aProp.Type) & ", " & _
RID_STR_COMMON_ATTRIBUTE_VALUE & " - " & aProp.value
myCustomDocumentProperties.item(aProp.name).Delete
-
+
Prepare_DocumentCustomProperties = True
-
+
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -140,14 +140,14 @@ Private Function GetProvider(hCtx As Long) As Boolean
Const NTE_KEYSET_NOT_DEF = &H80090019
Dim currentFunctionName As String
currentFunctionName = "GetProvider"
-
+
Dim strTemp As String
Dim strProvider As String
Dim strErrorMsg As String
Dim errStr As String
-
+
GetProvider = False
-
+
On Error Resume Next
strTemp = vbNullChar
strProvider = MS_DEFAULT_PROVIDER & vbNullChar
@@ -156,7 +156,7 @@ Private Function GetProvider(hCtx As Long) As Boolean
GetProvider = True
Exit Function
End If
-
+
Select Case Err.LastDllError
Case NTE_BAD_KEYSET
errStr = "Key container does not exist or You do not have access to the key container."
@@ -176,7 +176,7 @@ Function MD5HashString(ByVal Str As String) As String
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "MD5HashString"
-
+
Dim hCtx As Long
Dim hHash As Long
Dim ret As Long
@@ -185,7 +185,7 @@ Function MD5HashString(ByVal Str As String) As String
Dim abData() As Byte
If Not GetProvider(hCtx) Then Err.Raise Err.LastDllError
-
+
ret = CryptCreateHash(hCtx, MD5_ALGORITHM, 0, 0, hHash)
If ret = 0 Then Err.Raise Err.LastDllError
@@ -194,7 +194,7 @@ Function MD5HashString(ByVal Str As String) As String
ret = CryptGetHashParam(hHash, HP_HASHSIZE, lLen, 4, 0)
If ret = 0 Then Err.Raise Err.LastDllError
-
+
ReDim abData(0 To lLen - 1)
ret = CryptGetHashParam(hHash, HP_HASHVAL, abData(0), lLen, 0)
@@ -204,16 +204,15 @@ Function MD5HashString(ByVal Str As String) As String
MD5HashString = MD5HashString & Right$("0" & Hex$(abData(lIdx)), 2)
Next
CryptDestroyHash hHash
-
+
CryptReleaseContext hCtx, 0
FinalExit:
Exit Function
-
+
HandleErrors:
MD5HashString = ""
WriteDebug currentFunctionName & _
Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
End Function
-
diff --git a/main/migrationanalysis/src/driver_docs/sources/LocalizeResults.bas b/main/migrationanalysis/src/driver_docs/sources/LocalizeResults.bas
index f6ebe02493..cccb07a428 100644
--- a/main/migrationanalysis/src/driver_docs/sources/LocalizeResults.bas
+++ b/main/migrationanalysis/src/driver_docs/sources/LocalizeResults.bas
@@ -1,5 +1,5 @@
rem *************************************************************
-rem
+rem
rem Licensed to the Apache Software Foundation (ASF) under one
rem or more contributor license agreements. See the NOTICE file
rem distributed with this work for additional information
@@ -7,16 +7,16 @@ rem regarding copyright ownership. The ASF licenses this file
rem to you under the Apache License, Version 2.0 (the
rem "License"); you may not use this file except in compliance
rem with the License. You may obtain a copy of the License at
-rem
+rem
rem http://www.apache.org/licenses/LICENSE-2.0
-rem
+rem
rem Unless required by applicable law or agreed to in writing,
rem software distributed under the License is distributed on an
rem "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
rem KIND, either express or implied. See the License for the
rem specific language governing permissions and limitations
rem under the License.
-rem
+rem
rem *************************************************************
Attribute VB_Name = "LocalizeResults"
Sub Localize_WorkBook(aWorkBook As WorkBook)
diff --git a/main/migrationanalysis/src/driver_docs/sources/common_res.bas b/main/migrationanalysis/src/driver_docs/sources/common_res.bas
index e271c32ed2..aba5f3ca97 100644
--- a/main/migrationanalysis/src/driver_docs/sources/common_res.bas
+++ b/main/migrationanalysis/src/driver_docs/sources/common_res.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "common_res"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -275,4 +275,3 @@ Public Sub LoadCommonStrings(sdm As StringDataManager)
sdm.InitString RID_STR_COMMON_SUBISSUE_GRADIENT_CORNER_NOTE, "RID_STR_COMMON_SUBISSUE_GRADIENT_CORNER_NOTE"
sdm.InitString RID_STR_COMMON_SUBISSUE_GRADIENT_CENTER_NOTE, "RID_STR_COMMON_SUBISSUE_GRADIENT_CENTER_NOTE"
End Sub
-
diff --git a/main/migrationanalysis/src/driver_docs/sources/excel/ApplicationSpecific.bas b/main/migrationanalysis/src/driver_docs/sources/excel/ApplicationSpecific.bas
index 3c739e2601..d77957a47b 100644
--- a/main/migrationanalysis/src/driver_docs/sources/excel/ApplicationSpecific.bas
+++ b/main/migrationanalysis/src/driver_docs/sources/excel/ApplicationSpecific.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "ApplicationSpecific"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -116,13 +116,13 @@ End Function
Public Function getAppSpecificOLEClassType(aShape As Shape) As String
Dim objType As String
-
+
If aShape.OLEFormat.ProgID = "" Then
objType = aShape.OLEFormat.ClassType
Else
objType = aShape.OLEFormat.ProgID
End If
-
+
getAppSpecificOLEClassType = objType
End Function
@@ -134,13 +134,13 @@ End Sub
Public Sub LocalizeResources()
Dim xlStrings As StringDataManager
Set xlStrings = New StringDataManager
-
+
xlStrings.InitStringData (GetResourceDataFileName(ThisWorkbook.path))
LoadCommonStrings xlStrings
LoadExcelStrings xlStrings
LoadResultsStrings xlStrings
Set xlStrings = Nothing
-
+
SetWBDriverText
End Sub
@@ -155,4 +155,3 @@ Public Sub SetWBDriverText()
ThisWorkbook.Names("RID_STR_DVR_XL_THIS_DOC").RefersToRange.Cells(1, 1) = RID_STR_DVR_XL_THIS_DOC
ThisWorkbook.Names("RID_STR_DVR_XL_TITLE").RefersToRange.Cells(1, 1) = RID_STR_DVR_XL_TITLE
End Sub
-
diff --git a/main/migrationanalysis/src/driver_docs/sources/excel/Preparation.bas b/main/migrationanalysis/src/driver_docs/sources/excel/Preparation.bas
index b36f2e8d87..c786cb90ab 100644
--- a/main/migrationanalysis/src/driver_docs/sources/excel/Preparation.bas
+++ b/main/migrationanalysis/src/driver_docs/sources/excel/Preparation.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "Preparation"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -36,9 +36,7 @@ Function Prepare_WorkbookVersion() As Boolean
' The reason for having this function is more for documentation/structural
' purposes rather than actually needing the function.
' **************************************************************************
-
+
Prepare_WorkbookVersion = True
End Function
-
-
diff --git a/main/migrationanalysis/src/driver_docs/sources/excel/SetTextBoxFont.bas b/main/migrationanalysis/src/driver_docs/sources/excel/SetTextBoxFont.bas
index 9ffd0e01f2..413bcaf33b 100644
--- a/main/migrationanalysis/src/driver_docs/sources/excel/SetTextBoxFont.bas
+++ b/main/migrationanalysis/src/driver_docs/sources/excel/SetTextBoxFont.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "SetTextBoxFont"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -40,4 +40,3 @@ Public Sub SetTextBoxFont()
Next myShape
Range("A1").Select
End Sub
-
diff --git a/main/migrationanalysis/src/driver_docs/sources/excel/excel_res.bas b/main/migrationanalysis/src/driver_docs/sources/excel/excel_res.bas
index 37d97adf9c..1efc6725e6 100644
--- a/main/migrationanalysis/src/driver_docs/sources/excel/excel_res.bas
+++ b/main/migrationanalysis/src/driver_docs/sources/excel/excel_res.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "excel_res"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -366,4 +366,3 @@ Public Sub LoadExcelStrings(sdm As StringDataManager)
sdm.InitString RID_STR_DVR_XL_THIS_DOC, "RID_STR_DVR_XL_THIS_DOC"
sdm.InitString RID_STR_DVR_XL_TITLE, "RID_STR_DVR_XL_TITLE"
End Sub
-
diff --git a/main/migrationanalysis/src/driver_docs/sources/powerpoint/ApplicationSpecific.bas b/main/migrationanalysis/src/driver_docs/sources/powerpoint/ApplicationSpecific.bas
index ab4e9376d2..24a0d8d0e1 100644
--- a/main/migrationanalysis/src/driver_docs/sources/powerpoint/ApplicationSpecific.bas
+++ b/main/migrationanalysis/src/driver_docs/sources/powerpoint/ApplicationSpecific.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "ApplicationSpecific"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -145,7 +145,7 @@ Public Sub LocalizeResources()
LoadPPStrings ppStrings
LoadResultsStrings ppStrings
Set ppStrings = Nothing
-
+
SetPPDriverText
FinalExit:
Exit Sub
@@ -165,5 +165,3 @@ Sub SetPPDriverText()
ActivePresentation.Slides.item(1).Shapes.item("RID_STR_DVR_PP_TXT7").OLEFormat.Object.Text = RID_STR_DVR_PP_TXT7
ActivePresentation.Slides.item(1).Shapes.item("RID_STR_DVR_PP_TXT8").OLEFormat.Object.Text = RID_STR_DVR_PP_TXT8
End Sub
-
-
diff --git a/main/migrationanalysis/src/driver_docs/sources/powerpoint/Loader.bas b/main/migrationanalysis/src/driver_docs/sources/powerpoint/Loader.bas
index 36615b3565..4565f059a4 100644
--- a/main/migrationanalysis/src/driver_docs/sources/powerpoint/Loader.bas
+++ b/main/migrationanalysis/src/driver_docs/sources/powerpoint/Loader.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "Loader"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -34,7 +34,7 @@ Public Sub Presentation_Open()
LoadPPStrings ppStrings
LoadResultsStrings ppStrings
Set ppStrings = Nothing
-
+
SetPPDriverText
FinalExit:
Exit Sub
diff --git a/main/migrationanalysis/src/driver_docs/sources/powerpoint/Preparation.bas b/main/migrationanalysis/src/driver_docs/sources/powerpoint/Preparation.bas
index 2c6e6cf355..bce39ed387 100644
--- a/main/migrationanalysis/src/driver_docs/sources/powerpoint/Preparation.bas
+++ b/main/migrationanalysis/src/driver_docs/sources/powerpoint/Preparation.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "Preparation"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -31,4 +31,3 @@ End Function
Function Prepare_WorkbookVersion() As Boolean
Prepare_WorkbookVersion = False
End Function
-
diff --git a/main/migrationanalysis/src/driver_docs/sources/powerpoint/powerpoint_res.bas b/main/migrationanalysis/src/driver_docs/sources/powerpoint/powerpoint_res.bas
index 8a49c26a68..e99a885487 100644
--- a/main/migrationanalysis/src/driver_docs/sources/powerpoint/powerpoint_res.bas
+++ b/main/migrationanalysis/src/driver_docs/sources/powerpoint/powerpoint_res.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "powerpoint_res"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -89,7 +89,7 @@ Public Sub LoadPPStrings(sdm As StringDataManager)
sdm.InitString RID_STR_PP_ENUMERATION_VIEW_SLIDE_SORTER, "RID_STR_PP_ENUMERATION_VIEW_SLIDE_SORTER"
sdm.InitString RID_STR_PP_ENUMERATION_VIEW_TITLE_MASTER, "RID_STR_PP_ENUMERATION_VIEW_TITLE_MASTER"
sdm.InitString RID_STR_PP_ENUMERATION_UNKNOWN, "RID_STR_PP_ENUMERATION_UNKNOWN"
-
+
'Driver strings
sdm.InitString RID_STR_DVR_PP_TXT2, "RID_STR_DVR_PP_TXT2"
sdm.InitString RID_STR_DVR_PP_TXT3, "RID_STR_DVR_PP_TXT3"
diff --git a/main/migrationanalysis/src/driver_docs/sources/results_res.bas b/main/migrationanalysis/src/driver_docs/sources/results_res.bas
index 635f25f638..c830644425 100644
--- a/main/migrationanalysis/src/driver_docs/sources/results_res.bas
+++ b/main/migrationanalysis/src/driver_docs/sources/results_res.bas
@@ -1,5 +1,5 @@
rem *************************************************************
-rem
+rem
rem Licensed to the Apache Software Foundation (ASF) under one
rem or more contributor license agreements. See the NOTICE file
rem distributed with this work for additional information
@@ -7,16 +7,16 @@ rem regarding copyright ownership. The ASF licenses this file
rem to you under the Apache License, Version 2.0 (the
rem "License"); you may not use this file except in compliance
rem with the License. You may obtain a copy of the License at
-rem
+rem
rem http://www.apache.org/licenses/LICENSE-2.0
-rem
+rem
rem Unless required by applicable law or agreed to in writing,
rem software distributed under the License is distributed on an
rem "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
rem KIND, either express or implied. See the License for the
rem specific language governing permissions and limitations
rem under the License.
-rem
+rem
rem *************************************************************
Attribute VB_Name = "results_res"
Public RID_RESXLS_COST_Action_Settings As String
diff --git a/main/migrationanalysis/src/driver_docs/sources/word/ApplicationSpecific.bas b/main/migrationanalysis/src/driver_docs/sources/word/ApplicationSpecific.bas
index d6110276f6..4e9f75a9f9 100644
--- a/main/migrationanalysis/src/driver_docs/sources/word/ApplicationSpecific.bas
+++ b/main/migrationanalysis/src/driver_docs/sources/word/ApplicationSpecific.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "ApplicationSpecific"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -106,13 +106,13 @@ End Function
Public Function getAppSpecificOLEClassType(aShape As Shape) As String
Dim objType As String
-
+
If aShape.OLEFormat.ProgID = "" Then
objType = aShape.OLEFormat.ClassType
Else
objType = aShape.OLEFormat.ProgID
End If
-
+
getAppSpecificOLEClassType = objType
End Function
@@ -146,4 +146,3 @@ Private Sub SetWordDriverText()
ThisDocument.FormFields.item("RID_STR_WDVR_ISSUE").Result = RID_STR_WDVR_ISSUE
ThisDocument.FormFields.item("RID_STR_WDVR_PARA2").Result = RID_STR_WDVR_PARA2
End Sub
-
diff --git a/main/migrationanalysis/src/driver_docs/sources/word/Preparation.bas b/main/migrationanalysis/src/driver_docs/sources/word/Preparation.bas
index 326994a9bf..201b04a5d7 100644
--- a/main/migrationanalysis/src/driver_docs/sources/word/Preparation.bas
+++ b/main/migrationanalysis/src/driver_docs/sources/word/Preparation.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "Preparation"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -26,10 +26,10 @@ Function Prepare_HeaderFooter_GraphicFrames(docAnalysis As DocumentAnalysis, myI
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "Prepare_HeaderFooter_GraphicFrames"
-
+
Dim myPrepInfo As PrepareInfo
Set myPrepInfo = var
-
+
Dim smove As Long
Dim temp As Single
Dim ELength As Single
@@ -40,7 +40,7 @@ Function Prepare_HeaderFooter_GraphicFrames(docAnalysis As DocumentAnalysis, myI
Dim myshape As Shape
Dim shapetop() As Single
Dim temptop As Single
-
+
With currDoc.ActiveWindow 'change to printview
If .View.SplitSpecial = wdPaneNone Then
.ActivePane.View.Type = wdPrintView
@@ -50,14 +50,14 @@ Function Prepare_HeaderFooter_GraphicFrames(docAnalysis As DocumentAnalysis, myI
.View.Type = wdPrintView
End If
End With
-
+
PageHeight = currDoc.PageSetup.PageHeight
PageHeight = PageHeight / 2
-
+
Selection.GoTo what:=wdGoToPage, Which:=wdGoToAbsolute, _
count:=myPrepInfo.HF_OnPage
currDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
-
+
Snum = myPrepInfo.HF_Shapes.count
If Snum <> 0 Then
ReDim shapetop(Snum)
@@ -72,17 +72,17 @@ Function Prepare_HeaderFooter_GraphicFrames(docAnalysis As DocumentAnalysis, myI
End If
ElseIf myshape.Type = msoTextBox Then
myshape.TextFrame.TextRange.Select
-
+
shapetop(I) = Selection.Information(wdVerticalPositionRelativeToPage)
End If
I = I + 1
Next myshape
End If
-
+
currDoc.Content.Select
Selection.GoTo what:=wdGoToPage, Which:=wdGoToAbsolute, _
count:=myPrepInfo.HF_OnPage 'set frametop might change the selection position
-
+
If myPrepInfo.HF_inheader Then
currDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.MoveStart
@@ -112,7 +112,7 @@ Function Prepare_HeaderFooter_GraphicFrames(docAnalysis As DocumentAnalysis, myI
End If
ElseIf myshape.Type = msoTextBox Then
myshape.TextFrame.TextRange.Select
-
+
temptop = Selection.Information(wdVerticalPositionRelativeToPage)
End If
Selection.GoTo what:=wdGoToPage, Which:=wdGoToAbsolute, _
@@ -131,7 +131,7 @@ Function Prepare_HeaderFooter_GraphicFrames(docAnalysis As DocumentAnalysis, myI
Prepare_HeaderFooter_GraphicFrames = True
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -141,5 +141,3 @@ End Function
Function Prepare_WorkbookVersion() As Boolean
Prepare_WorkbookVersion = False
End Function
-
-
diff --git a/main/migrationanalysis/src/driver_docs/sources/word/word_res.bas b/main/migrationanalysis/src/driver_docs/sources/word/word_res.bas
index c828251a16..9efbd49131 100644
--- a/main/migrationanalysis/src/driver_docs/sources/word/word_res.bas
+++ b/main/migrationanalysis/src/driver_docs/sources/word/word_res.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "word_res"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -269,7 +269,7 @@ Public Sub LoadWordStrings(sdm As StringDataManager)
sdm.InitString RID_STR_WORD_SUBISSUE_TABLE_OF_AUTHORITIES, "RID_STR_WORD_SUBISSUE_TABLE_OF_AUTHORITIES"
sdm.InitString RID_STR_WORD_SUBISSUE_TABLE_OF_AUTHORITIES_FIELD, "RID_STR_WORD_SUBISSUE_TABLE_OF_AUTHORITIES_FIELD"
sdm.InitString RID_STR_WORD_ATTRIBUTE_COUNT, "RID_STR_WORD_ATTRIBUTE_COUNT"
-
+
'Word driver strings
sdm.InitString RID_STR_WDVR_SOANA, "RID_STR_WDVR_SOANA"
sdm.InitString RID_STR_WDVR_INTRO, "RID_STR_WDVR_INTRO"
@@ -279,4 +279,3 @@ Public Sub LoadWordStrings(sdm As StringDataManager)
sdm.InitString RID_STR_WDVR_ISSUE, "RID_STR_WDVR_ISSUE"
sdm.InitString RID_STR_WDVR_PARA2, "RID_STR_WDVR_PARA2"
End Sub
-
diff --git a/main/migrationanalysis/src/wizard/Analyse.bas b/main/migrationanalysis/src/wizard/Analyse.bas
index 4abaec9e68..0fee1863a8 100644
--- a/main/migrationanalysis/src/wizard/Analyse.bas
+++ b/main/migrationanalysis/src/wizard/Analyse.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "Analyse"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -122,7 +122,7 @@ Public Type PROCESSENTRY32
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
-
+
Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" _
(ByVal lFlags As Long, ByVal lProcessID As Long) As Long
@@ -179,7 +179,7 @@ Public Function IsOfficeAppRunning(curApplication As String) As Boolean
End If
Wend
bRet = bAppFound
-
+
Call CloseHandle(hSnapShot)
FinalExit:
@@ -209,7 +209,7 @@ Private Sub CalculateProgress(statusFileName As String, fso As FileSystemObject,
curFile = Mid(statLine, Len(C_STAT_ANALYSING) + 1)
End If
End If
-
+
' when we don't have a file, we will show the name of the last used file in
' the progress window
If (curFile = "") Then curFile = myDocList.item(lastIndex)
@@ -293,7 +293,7 @@ Public Function launchDriver(statFileName As String, cmdLine As String, _
' Initialize the STARTUPINFO structure:
start.cb = Len(start)
-
+
' Start the shelled application:
ret = CreateProcessA(vbNullString, cmdLine$, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)
@@ -326,7 +326,7 @@ Public Function launchDriver(statFileName As String, cmdLine As String, _
Call CalculateProgress(statFileName, fso, lastIndex, myOffset, myDocList)
DoEvents 'allow other processes
Loop While True
-
+
If (ret <> WAIT_TIMEOUT) And (ret <> ABORTED) Then
Call GetExitCodeProcess(proc.hProcess, ret&)
End If
@@ -385,17 +385,17 @@ Function WriteDocsToAnalyze(myDocList As Collection, myApp As String, _
Dim vFileName As Variant
Dim Index As Long
Dim limit As Long
-
+
limit = myDocList.count
If (limit > 0) Then
fileName = fso.GetAbsolutePathName(TempPath & "\FileList" & myApp & ".txt")
Set fileContent = fso.OpenTextFile(fileName, ForWriting, True, TristateTrue)
-
+
For Index = 1 To limit
vFileName = myDocList(Index)
fileContent.WriteLine (vFileName)
Next
-
+
fileContent.Close
End If
@@ -418,14 +418,14 @@ Function GetDocumentIndex(myDocument As String, _
Dim currentFunctionName As String
currentFunctionName = "GetDocumentIndex"
-
+
On Error GoTo HandleErrors
-
+
Dim lastEntry As Long
Dim curIndex As Long
Dim curEntry As String
Dim entryFound As Boolean
-
+
entryFound = False
lastEntry = myDocList.count
curIndex = lastIndex
@@ -528,7 +528,7 @@ Function AnalyseList(myDocList As Collection, _
nRetries = nRetries + 1
End If
Wend
-
+
If (analyseStatus = C_STAT_DONE) Then
AnalyseList = True
Else
@@ -577,6 +577,6 @@ Sub HandleAbort(hProcess As Long, curApplication As String)
ShowProgress.g_SP_AllowOtherDLG = True
TerminateMSO.Show vbModal, ShowProgress
End If
-
+
ret = TerminateProcess(hProcess, "0")
End Sub
diff --git a/main/migrationanalysis/src/wizard/Get Directory Dialog.bas b/main/migrationanalysis/src/wizard/Get Directory Dialog.bas
index d486bc62f8..cbc3f85921 100644
--- a/main/migrationanalysis/src/wizard/Get Directory Dialog.bas
+++ b/main/migrationanalysis/src/wizard/Get Directory Dialog.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "BrowseDirectorysOnly"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -108,27 +108,27 @@ Public Function BrowseForFolder(owner As Form, Title As String, StartDir As Stri
Else
BrowseForFolder = ""
End If
-
+
End Function
-
+
Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
-
+
Dim lpIDList As Long
Dim ret As Long
Dim sBuffer As String
-
+
On Error Resume Next 'Suggested by MS to prevent an error from
'propagating back into the calling process.
-
+
Select Case uMsg
-
+
Case BFFM_INITIALIZED
Call SendMessage(hWnd, BFFM_SETSELECTION, 1, m_CurrentDirectory)
-
+
End Select
-
+
BrowseCallbackProc = 0
-
+
End Function
' This function allows you to assign a function pointer to a variable.
diff --git a/main/migrationanalysis/src/wizard/IniSupport.bas b/main/migrationanalysis/src/wizard/IniSupport.bas
index 52a3d381e8..61a568127e 100644
--- a/main/migrationanalysis/src/wizard/IniSupport.bas
+++ b/main/migrationanalysis/src/wizard/IniSupport.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "IniSupport"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -29,7 +29,7 @@ Private Declare Function GetPrivateProfileString Lib "kernel32" _
ByVal lpReturnedString As String, _
ByVal nSize As Long, _
ByVal lpFileName As String) As Long
-
+
Private Declare Function WritePrivateProfileString Lib "kernel32" _
Alias "WritePrivateProfileStringA" _
(ByVal lpSectionName As String, _
@@ -45,11 +45,11 @@ Public Function ProfileGetItem(lpSectionName As String, _
'Retrieves a value from an ini file corresponding
'to the section and key name passed.
-
+
Dim success As Long
Dim nSize As Long
Dim ret As String
-
+
'call the API with the parameters passed.
'The return value is the length of the string
'in ret, including the terminating null. If a
@@ -67,11 +67,11 @@ Public Function ProfileGetItem(lpSectionName As String, _
ret, _
nSize, _
inifile)
-
+
If success Then
ProfileGetItem = Left$(ret, success)
End If
-
+
End Function
@@ -95,7 +95,7 @@ Public Sub ProfileDeleteItem(lpSectionName As String, _
' [Colours]
' Colour1=Red
' Colour3=Green
-
+
Call WritePrivateProfileString(lpSectionName, _
lpKeyName, _
vbNullString, _
@@ -120,7 +120,7 @@ Public Sub ProfileDeleteSection(lpSectionName As String, _
'and this sub was called passing "Colours"
'as lpSectionName, the resulting Colours
'section in the ini file would be deleted.
-
+
Call WritePrivateProfileString(lpSectionName, _
vbNullString, _
vbNullString, _
@@ -137,15 +137,15 @@ Private Function StripNulls(startStrg As String) As String
Dim pos As Long
Dim item As String
-
+
pos = InStr(1, startStrg, Chr$(0))
-
+
If pos Then
item = Mid$(startStrg, 1, pos - 1)
startStrg = Mid$(startStrg, pos + 1, Len(startStrg))
StripNulls = item
-
+
End If
End Function
@@ -159,7 +159,7 @@ Public Function ProfileLoadList(lst As ComboBox, _
Dim KeyData As String
Dim lpKeyName As String
Dim ret As String
-
+
' call the API passing lpKeyName = null. This causes
' the API to return a list of all keys under that section.
' Pad the passed string large enough to hold the data.
@@ -167,7 +167,7 @@ Public Function ProfileLoadList(lst As ComboBox, _
nSize = Len(ret)
success = GetPrivateProfileString( _
lpSectionName, vbNullString, "", ret, nSize, inifile)
-
+
' The returned string is a null-separated list of key names,
' terminated by a pair of null characters.
' If the Get call was successful, success holds the length of the
@@ -175,15 +175,15 @@ Public Function ProfileLoadList(lst As ComboBox, _
' The ProfileGetItem function below extracts each key item using the
' nulls as markers, so trim off the terminating null.
If success Then
-
+
'trim terminating null and trailing spaces
ret = Left$(ret, success)
-
+
'with the resulting string extract each element
Do Until ret = ""
'strip off an item (i.e. "Item1", "Item2")
lpKeyName = StripNulls(ret)
-
+
'pass the lpKeyName received to a routine that
'again calls GetPrivateProfileString, this
'time passing the real key name. Returned
@@ -192,13 +192,13 @@ Public Function ProfileLoadList(lst As ComboBox, _
'entry "Item1=Apple"
KeyData = ProfileGetItem( _
lpSectionName, lpKeyName, "", inifile)
-
+
'add the item returned to the listbox
lst.AddItem KeyData
Loop
-
+
End If
-
+
'return the number of items as an
'indicator of success
ProfileLoadList = lst.ListCount
@@ -213,7 +213,7 @@ Public Function ProfileLoadDict(dict As Scripting.Dictionary, _
Dim KeyData As String
Dim lpKeyName As String
Dim ret As String
-
+
' call the API passing lpKeyName = null. This causes
' the API to return a list of all keys under that section.
' Pad the passed string large enough to hold the data.
@@ -221,7 +221,7 @@ Public Function ProfileLoadDict(dict As Scripting.Dictionary, _
nSize = Len(ret)
success = GetPrivateProfileString( _
lpSectionName, vbNullString, "", ret, nSize, inifile)
-
+
' The returned string is a null-separated list of key names,
' terminated by a pair of null characters.
' If the Get call was successful, success holds the length of the
@@ -229,15 +229,15 @@ Public Function ProfileLoadDict(dict As Scripting.Dictionary, _
' The ProfileGetItem function below extracts each key item using the
' nulls as markers, so trim off the terminating null.
If success Then
-
+
'trim terminating null and trailing spaces
ret = Left$(ret, success)
-
+
'with the resulting string extract each element
Do Until ret = ""
'strip off an item (i.e. "Item1", "Item2")
lpKeyName = StripNulls(ret)
-
+
'pass the lpKeyName received to a routine that
'again calls GetPrivateProfileString, this
'time passing the real key name. Returned
@@ -246,18 +246,11 @@ Public Function ProfileLoadDict(dict As Scripting.Dictionary, _
'entry "Item1=Apple"
KeyData = ProfileGetItem( _
lpSectionName, lpKeyName, "", inifile)
-
+
dict.add lpKeyName, KeyData
Loop
-
+
End If
-
+
ProfileLoadDict = dict.count
End Function
-
-
-
-
-
-
-
diff --git a/main/migrationanalysis/src/wizard/Office10Issues.bas b/main/migrationanalysis/src/wizard/Office10Issues.bas
index 5d26676240..1f2baedf7b 100644
--- a/main/migrationanalysis/src/wizard/Office10Issues.bas
+++ b/main/migrationanalysis/src/wizard/Office10Issues.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "Office10Issues"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -86,7 +86,7 @@ Public Function CreateRegKey(hKey As RegHive, strPath As String)
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "CreateRegKey"
-
+
Dim heKey As Long
Dim secattr As SECURITY_ATTRIBUTES ' security settings for the key
Dim subkey As String ' name of the subkey to create or open
@@ -98,14 +98,14 @@ Public Function CreateRegKey(hKey As RegHive, strPath As String)
secattr.nLength = Len(secattr)
secattr.lpSecurityDescriptor = 0
secattr.bInheritHandle = 1
-
+
retval = RegCreateKeyEx(hKey, strPath, 0, "", 0, KEY_WRITE, _
secattr, heKey, neworused)
If retval = 0 Then
retval = RegCloseKey(hKey)
Exit Function
End If
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
End Function
@@ -115,7 +115,7 @@ Public Function CreateRegKey2(hKey As RegHive, strPath As String) As Long
Dim currentFunctionName As String
currentFunctionName = "CreateRegKey"
CreateRegKey2 = 0
-
+
Dim heKey As Long
Dim secattr As SECURITY_ATTRIBUTES ' security settings for the key
Dim subkey As String ' name of the subkey to create or open
@@ -127,7 +127,7 @@ Public Function CreateRegKey2(hKey As RegHive, strPath As String) As Long
secattr.nLength = Len(secattr)
secattr.lpSecurityDescriptor = 0
secattr.bInheritHandle = 1
-
+
retval = RegCreateKeyEx(hKey, strPath, 0, "", 0, KEY_WRITE, _
secattr, heKey, neworused)
If retval = ERROR_SUCCESS Then
@@ -137,7 +137,7 @@ Public Function CreateRegKey2(hKey As RegHive, strPath As String) As Long
FinalExit:
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
CreateRegKey2 = 0
@@ -149,7 +149,7 @@ Public Function GetRegLong(ByVal hKey As RegHive, ByVal strPath As String, ByVal
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "GetRegLong"
-
+
Dim lRegResult As Long
Dim lValueType As Long
Dim lBuffer As Long
@@ -159,14 +159,14 @@ Public Function GetRegLong(ByVal hKey As RegHive, ByVal strPath As String, ByVal
GetRegLong = 0
lRegResult = RegOpenKey(hKey, strPath, hCurKey)
lDataBufferSize = 4 '4 bytes = 32 bits = long
-
+
lRegResult = RegQueryValueEx(hCurKey, strValue, 0, REG_DWORD, lBuffer, lDataBufferSize)
If lRegResult = ERROR_SUCCESS Then
GetRegLong = lBuffer
End If
lRegResult = RegCloseKey(hCurKey)
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
End Function
@@ -175,18 +175,18 @@ Public Function SaveRegLong(ByVal hKey As RegHive, ByVal strPath As String, ByVa
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "SaveRegLong"
-
+
Const NumofByte = 4
Dim hCurKey As Long
Dim lRegResult As Long
-
+
lRegResult = RegCreateKey(hKey, strPath, hCurKey)
lRegResult = RegSetValueEx(hCurKey, strValue, 0&, REG_DWORD, lData, NumofByte)
If lRegResult = ERROR_SUCCESS Then
lRegResult = RegCloseKey(hCurKey)
Exit Function
End If
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
End Function
@@ -197,7 +197,7 @@ Public Function GiveAccessToMacroProject(application As String, sVersion As Stri
Dim currentFunctionName As String
currentFunctionName = "SaveRegLong"
GiveAccessToMacroProject = False
-
+
Const OfficePath = "Software\Policies\Microsoft\Office\"
Const security = "\Security"
Const AccessVBOM = "AccessVBOM"
@@ -212,7 +212,7 @@ Public Function GiveAccessToMacroProject(application As String, sVersion As Stri
SaveRegLong HKEY_CURRENT_USER, subpath, AccessVBOM, AccessVBOMValue
GiveAccessToMacroProject = True
Exit Function
-
+
HandleErrors:
GiveAccessToMacroProject = False
WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
@@ -222,16 +222,16 @@ Public Function SetDefaultRegValue(application As String, sVersion As String, sV
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "SaveRegLong"
-
+
Const OfficePath = "Software\Policies\Microsoft\Office\"
Const security = "\Security"
Const AccessVBOM = "AccessVBOM"
Dim subpath As String
-
+
subpath = OfficePath & sVersion & "\" & application & security
SaveRegLong HKEY_CURRENT_USER, subpath, AccessVBOM, sValue
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
End Function
@@ -239,14 +239,14 @@ Public Function DeleteRegValue(application As String, sVersion As String)
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "SaveRegLong"
-
+
Const OfficePath = "Software\Policies\Microsoft\Office\"
Const security = "\Security"
Const AccessVBOM = "AccessVBOM"
Dim subpath As String
Dim retval As Long
Dim hKey As Long
-
+
subpath = OfficePath & sVersion & "\" & application & security
retval = RegOpenKeyEx(HKEY_CURRENT_USER, subpath, 0, KEY_WRITE, hKey)
If retval = ERROR_SUCCESS Then
@@ -254,7 +254,7 @@ Public Function DeleteRegValue(application As String, sVersion As String)
retval = RegCloseKey(hKey)
Exit Function
End If
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
End Function
@@ -264,7 +264,7 @@ Public Function CheckForAccesToWordVBProject1(wrd As Word.application, RestoreVa
CheckForAccesToWordVBProject1 = True
RestoreValue = -1
If val(wrd.Version) < 10# Then Exit Function
-
+
Set myProject = wrd.ActiveDocument.VBProject
If Err.Number <> 0 Then
Dim RegValue As Long
@@ -275,25 +275,25 @@ Public Function CheckForAccesToWordVBProject1(wrd As Word.application, RestoreVa
CheckForAccesToWordVBProject1 = False
End If
End If
-
+
End Function
Public Function CheckForAccesToWordVBProject(wrd As Word.application) As Boolean
On Error Resume Next
CheckForAccesToWordVBProject = True
If val(wrd.Version) < 10# Then Exit Function
-
+
Set myProject = wrd.ActiveDocument.VBProject
If Err.Number <> 0 Then
CheckForAccesToWordVBProject = False
End If
-
+
End Function
Public Function CheckForAccesToExcelVBProject1(xl As Excel.application, RestoreValue As Long) As Boolean
On Error Resume Next
CheckForAccesToExcelVBProject1 = True
RestoreValue = -1
If val(xl.Version) < 10# Then Exit Function
-
+
Dim displayAlerts As Boolean
displayAlerts = xl.displayAlerts
xl.displayAlerts = False
@@ -314,7 +314,7 @@ Public Function CheckForAccesToExcelVBProject(xl As Excel.application) As Boolea
On Error Resume Next
CheckForAccesToExcelVBProject = True
If val(xl.Version) < 10# Then Exit Function
-
+
Dim displayAlerts As Boolean
displayAlerts = xl.displayAlerts
xl.displayAlerts = False
diff --git a/main/migrationanalysis/src/wizard/RunServer.bas b/main/migrationanalysis/src/wizard/RunServer.bas
index bd08518c22..e720eb2ac9 100644
--- a/main/migrationanalysis/src/wizard/RunServer.bas
+++ b/main/migrationanalysis/src/wizard/RunServer.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "RunServer"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -50,7 +50,7 @@ Sub Main()
Dim fso As New FileSystemObject
Dim driverName As String
-
+
If (serverType = CWORD_APP) Then
driverName = fso.GetAbsolutePathName(".\" & CWORD_DRIVER)
ElseIf (serverType = CEXCEL_APP) Then
@@ -96,12 +96,12 @@ Sub OpenWordDriverDoc(fso As FileSystemObject, driverName As String)
Set wrdApp = New Word.Application
Set wrdDriverDoc = wrdApp.Documents.Open(driverName)
-
+
wrdApp.Run ("AnalysisTool.AnalysisDriver.AnalyseDirectory")
If Err.Number <> 0 Then
WriteToLog fso, CWORD_APP, "OpenWordDriverDoc: " & Err.Number & " " & Err.Description & " " & Err.Source
End If
-
+
wrdDriverDoc.Close wdDoNotSaveChanges
wrdApp.Quit False
@@ -189,4 +189,3 @@ Sub WriteToLog(fso As FileSystemObject, currApp As String, errMsg As String)
Call WritePrivateProfileString("ERRORS", currApp & "_log" & ErrCount, _
errMsg, logFileName)
End Sub
-
diff --git a/main/migrationanalysis/src/wizard/Utilities.bas b/main/migrationanalysis/src/wizard/Utilities.bas
index f1e864d00f..82ad9b3d0c 100644
--- a/main/migrationanalysis/src/wizard/Utilities.bas
+++ b/main/migrationanalysis/src/wizard/Utilities.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "Utilities"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -106,7 +106,7 @@ Private Declare Function ShellExecute Lib "shell32" _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
-
+
Public Const SW_SHOWNORMAL As Long = 1
Public Const SW_SHOWMAXIMIZED As Long = 3
Public Const SW_SHOWDEFAULT As Long = 10
@@ -135,7 +135,7 @@ Private Const KEY_READ As Long = ((STANDARD_RIGHTS_READ Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And _
(Not SYNCHRONIZE))
-
+
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" _
(ByVal hKey As Long, _
@@ -155,7 +155,7 @@ Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
-
+
Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long
@@ -179,11 +179,11 @@ Private Declare Function SHGetSpecialFolderLocation Lib _
Public Function IsWin98Plus() As Boolean
'returns True if running Windows 2000 or later
Dim osv As OSVERSIONINFO
-
+
osv.OSVSize = Len(osv)
-
+
If GetVersionEx(osv) = 1 Then
-
+
Select Case osv.PlatformID 'win 32
Case VER_PLATFORM_WIN32s:
IsWin98Plus = False
@@ -212,7 +212,7 @@ Public Function IsWin98Plus() As Boolean
IsWin98Plus = False
Exit Function
End Select
-
+
End If
End Function
@@ -223,23 +223,23 @@ Public Function GetWinVersion(WIN As RGB_WINVER) As String
'filled with OS information
#If Win32 Then
-
+
Dim osv As OSVERSIONINFO
Dim pos As Integer
Dim sVer As String
Dim sBuild As String
-
+
osv.OSVSize = Len(osv)
-
+
If GetVersionEx(osv) = 1 Then
-
+
'PlatformId contains a value representing the OS
WIN.PlatformID = osv.PlatformID
-
+
Select Case osv.PlatformID
Case VER_PLATFORM_WIN32s: WIN.VersionName = "Win32s"
Case VER_PLATFORM_WIN32_NT: WIN.VersionName = "Windows NT"
-
+
Select Case osv.dwVerMajor
Case 4: WIN.VersionName = "Windows NT"
Case 5:
@@ -248,25 +248,25 @@ Public Function GetWinVersion(WIN As RGB_WINVER) As String
Case 1: WIN.VersionName = "Windows XP"
End Select
End Select
-
+
Case VER_PLATFORM_WIN32_WINDOWS:
-
+
'The dwVerMinor bit tells if its 95 or 98.
Select Case osv.dwVerMinor
Case 0: WIN.VersionName = "Windows 95"
Case 90: WIN.VersionName = "Windows ME"
Case Else: WIN.VersionName = "Windows 98"
End Select
-
+
End Select
-
-
+
+
'Get the version number
WIN.VersionNo = osv.dwVerMajor & "." & osv.dwVerMinor
-
+
'Get the build
WIN.BuildNo = (osv.dwBuildNumber And &HFFFF&)
-
+
'Any additional info. In Win9x, this can be
'"any arbitrary string" provided by the
'manufacturer. In NT, this is the service pack.
@@ -276,15 +276,15 @@ Public Function GetWinVersion(WIN As RGB_WINVER) As String
End If
End If
-
+
#Else
-
+
'can only return that this does not
'support the 32 bit call, so must be Win3x
WIN.VersionName = "Windows 3.x"
#End If
GetWinVersion = WIN.VersionName
-
+
End Function
Public Sub RunShellExecute(sTopic As String, _
@@ -295,11 +295,11 @@ Public Sub RunShellExecute(sTopic As String, _
Dim hWndDesk As Long
Dim success As Long
-
+
'the desktop will be the
'default for error messages
hWndDesk = GetDesktopWindow()
-
+
'execute the passed operation
success = ShellExecute(hWndDesk, sTopic, sFile, sParams, sDirectory, nShowCmd)
@@ -309,7 +309,7 @@ Public Sub RunShellExecute(sTopic As String, _
If success = SE_ERR_NOASSOC Then
Call Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " & sFile, vbNormalFocus)
End If
-
+
End Sub
Public Sub WriteToLog(key As String, value As String, _
@@ -336,14 +336,14 @@ Public Sub WriteDebug(value As String)
Static ErrCount As Long
Static logFile As String
Static debugLevel As Long
-
+
If logFile = "" Then
logFile = GetLogFilePath
End If
-
+
Dim sSection As String
sSection = WIZARD_NAME & "Debug"
-
+
Call WritePrivateProfileString(sSection, "Analysis" & "_debug" & ErrCount, _
value, logFile)
ErrCount = ErrCount + 1
@@ -351,11 +351,11 @@ End Sub
Public Function GetDebug(section As String, key As String) As String
Static logFile As String
-
+
If logFile = "" Then
logFile = GetLogFilePath
End If
-
+
GetDebug = ProfileGetItem(section, key, "", logFile)
End Function
@@ -368,38 +368,38 @@ Public Function GetUserLocaleInfo(ByVal dwLocaleID As Long, ByVal dwLCType As Lo
'variable to retrieve the required size of
'the string buffer needed
r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
-
+
'if successful..
If r Then
-
+
'pad the buffer with spaces
sReturn = Space$(r)
-
+
'and call again passing the buffer
r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
-
+
'if successful (r > 0)
If r Then
-
+
'r holds the size of the string
'including the terminating null
GetUserLocaleInfo = Left$(sReturn, r - 1)
-
+
End If
-
+
End If
-
+
End Function
Public Function GetRegistryInfo(sHive As String, sSubKey As String, sKey As String) As String
GetRegistryInfo = ""
Dim hKey As Long
-
+
hKey = OpenRegKey(sHive, sSubKey)
-
+
If hKey <> 0 Then
GetRegistryInfo = GetRegValue(hKey, sKey)
-
+
'the opened key must be closed
Call RegCloseKey(hKey)
End If
@@ -413,7 +413,7 @@ Private Function GetRegValue(hSubKey As Long, sKeyName As String) As String
'if valid
If hSubKey <> 0 Then
-
+
'Pass an zero-length string to
'obtain the required buffer size
'required to return the result.
@@ -432,7 +432,7 @@ Private Function GetRegValue(hSubKey As Long, sKeyName As String) As String
lpcbData) = ERROR_MORE_DATA Then
lpValue = Space$(lpcbData)
-
+
'retrieve the desired value
If RegQueryValueEx(hSubKey, _
sKeyName, _
@@ -440,9 +440,9 @@ Private Function GetRegValue(hSubKey As Long, sKeyName As String) As String
0&, _
ByVal lpValue, _
lpcbData) = ERROR_SUCCESS Then
-
+
GetRegValue = TrimNull(lpValue)
-
+
End If 'If RegQueryValueEx (second call)
End If 'If RegQueryValueEx (first call)
End If 'If hSubKey
@@ -466,28 +466,28 @@ End Function
Private Function TrimNull(startstr As String) As String
TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
-
+
End Function
Function GetLogFilePath() As String
Dim fso As New FileSystemObject
Dim TempPath As String
-
+
TempPath = fso.GetSpecialFolder(TemporaryFolder).path
-
+
If (TempPath = "") Then
TempPath = "."
End If
GetLogFilePath = fso.GetAbsolutePathName(TempPath & "\" & CSTR_LOG_FILE_NAME)
End Function
-
+
Function GetIniFilePath() As String
Dim fso As New FileSystemObject
Dim AppDataDir As String
-
+
AppDataDir = GetAppDataFolder
If (AppDataDir = "") Then
AppDataDir = CBASE_RESOURCE_DIR
@@ -541,6 +541,3 @@ Err_GetFolder:
Resume Exit_GetFolder
End Function
-
-
-
diff --git a/main/migrationanalysis/src/wizard/Wizard.bas b/main/migrationanalysis/src/wizard/Wizard.bas
index b749118e6a..ac390c2b9a 100644
--- a/main/migrationanalysis/src/wizard/Wizard.bas
+++ b/main/migrationanalysis/src/wizard/Wizard.bas
@@ -8,9 +8,9 @@ Attribute VB_Name = "modWizard"
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
-'
+'
' http://www.apache.org/licenses/LICENSE-2.0
-'
+'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
@@ -245,7 +245,7 @@ Function getLocaleLangBaseIDandSetLocaleDir() As Integer
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "getLocaleLangBaseIDandSetLocaleDir"
-
+
Dim baseID As Long
Dim bUseLocale As Boolean
Dim fso As FileSystemObject
@@ -254,19 +254,19 @@ Function getLocaleLangBaseIDandSetLocaleDir() As Integer
Dim isoLangStr As String
Dim isoCountryStr As String
Dim langStr As String
-
+
Dim userLCID As Long
userLCID = GetUserDefaultLCID()
Dim sysLCID As Long
sysLCID = GetSystemDefaultLCID()
-
+
isoLangStr = GetUserLocaleInfo(sysLCID, LOCALE_SISO639LANGNAME)
isoCountryStr = GetUserLocaleInfo(sysLCID, LOCALE_SISO3166CTRYNAME)
langStr = GetUserLocaleInfo(sysLCID, LOCALE_SENGLANGUAGE)
-
+
baseID = 0
mLocaleDir = ""
-
+
If fso.FileExists(fso.GetAbsolutePathName("debug.ini")) Then
Dim overrideLangStr As String
overrideLangStr = ProfileGetItem("debug", "langoverride", "", fso.GetAbsolutePathName("debug.ini"))
@@ -275,7 +275,7 @@ Function getLocaleLangBaseIDandSetLocaleDir() As Integer
isoLangStr = overrideLangStr
End If
End If
-
+
'check for locale dirs in following order:
' CBASE_RESOURCE_DIR & "\" & isoLangStr
' CBASE_RESOURCE_DIR & "\" & isoLangStr & "-" & isoCountryStr
@@ -290,14 +290,14 @@ Function getLocaleLangBaseIDandSetLocaleDir() As Integer
mLocaleDir = CBASE_RESOURCE_DIR
baseID = 1000
'End If
-
+
getLocaleLangBaseIDandSetLocaleDir = CInt(baseID)
-
+
FinalExit:
Set fso = Nothing
Exit Function
-
+
HandleErrors:
Debug.Print currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -316,12 +316,12 @@ Function GetResString(nRes As Integer) As String
Dim sRes As String * 1024
Dim sRetStr As String
Dim nRet As Long
-
+
Do
'sTmp = LoadResString(nRes)
nRet = LoadString(ghInst, nRes, sRes, 1024)
sTmp = Left$(sRes, nRet)
-
+
If Right(sTmp, 1) = "_" Then
sRetStr = sRetStr + VBA.Left(sTmp, Len(sTmp) - 1)
Else
@@ -330,16 +330,16 @@ Function GetResString(nRes As Integer) As String
nRes = nRes + 1
Loop Until Right(sTmp, 1) <> "_"
GetResString = sRetStr
-
+
End Function
Function GetField(sBuffer As String, sSep As String) As String
Dim p As Integer
-
+
p = InStr(sBuffer & sSep, sSep)
GetField = VBA.Left(sBuffer, p - 1)
sBuffer = Mid(sBuffer, p + Len(sSep))
-
+
End Function
' Parts of the following code are from:
' http://support.microsoft.com/default.aspx?scid=kb;en-us;232625&Product=vb6
@@ -385,19 +385,19 @@ Private Function GetResourceDataFileName() As String
On Error GoTo HandleErrors
Dim currentFunctionName As String
currentFunctionName = "GetResourceDataFileName"
-
+
Dim fileName As String
Dim fso As FileSystemObject
Set fso = New FileSystemObject
GetResourceDataFileName = fso.GetAbsolutePathName(RES_PREFIX)
-
+
GoTo FinalExit
' use the following code when we have one resource file for each language
Dim isoLangStr As String
Dim isoCountryStr As String
-
+
Dim userLCID As Long
userLCID = GetUserDefaultLangID()
Dim sysLCID As Long
@@ -405,7 +405,7 @@ Private Function GetResourceDataFileName() As String
isoLangStr = GetUserLocaleInfo(userLCID, LOCALE_SISO639LANGNAME)
isoCountryStr = GetUserLocaleInfo(userLCID, LOCALE_SISO3166CTRYNAME)
-
+
'check for locale data in following order:
' user language
' isoLangStr & "_" & isoCountryStr & ".dll"
@@ -414,7 +414,7 @@ Private Function GetResourceDataFileName() As String
' isoLangStr & "_" & isoCountryStr & ".dll"
' isoLangStr & ".dll"
' "en_US" & ".dll"
-
+
fileName = fso.GetAbsolutePathName(RES_PREFIX & isoLangStr & "-" & isoCountryStr & ".dll")
If fso.FileExists(fileName) Then
GetResourceDataFileName = fileName
@@ -442,7 +442,7 @@ Private Function GetResourceDataFileName() As String
FinalExit:
Set fso = Nothing
Exit Function
-
+
HandleErrors:
WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
@@ -462,10 +462,10 @@ Sub LoadResStrings(frm As Form)
ghInst = LoadLibrary(GetResourceDataFileName())
On Error Resume Next
-
+
sCodePage = String$(16, " ")
LCID = GetThreadLocale() 'Get Current locale
-
+
X = GetLocaleInfo(LCID, LOCALE_IDEFAULTANSICODEPAGE, _
sCodePage, Len(sCodePage)) 'Get code page
sCodePage = StripNullTerminator(sCodePage)
@@ -475,7 +475,7 @@ Sub LoadResStrings(frm As Form)
If IsNumeric(frm.Tag) Then
frm.Caption = LoadResString(CInt(frm.Tag))
End If
-
+
'set the controls' captions using the caption
'property for menu items and the Tag property
'for all other controls
@@ -535,7 +535,7 @@ FinalExit:
HandleErrors:
WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
Resume FinalExit
-
+
End Sub
'==================================================
@@ -553,10 +553,10 @@ Function ReplaceTopicTokens(sString As String, _
sToken As String, _
sReplacement As String) As String
On Error Resume Next
-
+
Dim p As Integer
Dim sTmp As String
-
+
sTmp = sString
Do
p = InStr(sTmp, sToken)
@@ -564,10 +564,10 @@ Function ReplaceTopicTokens(sString As String, _
sTmp = VBA.Left(sTmp, p - 1) + sReplacement + Mid(sTmp, p + Len(sToken))
End If
Loop While p
-
-
+
+
ReplaceTopicTokens = sTmp
-
+
End Function
'==================================================
'Purpose: Replace the sToken1 and sToken2 strings in
@@ -588,7 +588,7 @@ Function ReplaceTopic2Tokens(sString As String, _
sToken2 As String, _
sReplacement2 As String) As String
On Error Resume Next
-
+
ReplaceTopic2Tokens = _
ReplaceTopicTokens(ReplaceTopicTokens(sString, sToken1, sReplacement1), _
sToken2, sReplacement2)
@@ -598,7 +598,7 @@ End Function
Public Function GetResData(sResName As String, sResType As String) As String
Dim sTemp As String
Dim p As Integer
-
+
sTemp = StrConv(LoadResData(sResName, sResType), vbUnicode)
p = InStr(sTemp, vbNullChar)
If p Then sTemp = VBA.Left$(sTemp, p - 1)
@@ -607,18 +607,18 @@ End Function
Function AddToAddInCommandBar(VBInst As Object, sCaption As String, oBitmap As Object) As Object 'Office.CommandBarControl
On Error GoTo AddToAddInCommandBarErr
-
+
Dim c As Integer
Dim cbMenuCommandBar As Object 'Office.CommandBarControl 'command bar object
Dim cbMenu As Object
-
+
'see if we can find the Add-Ins menu
Set cbMenu = VBInst.CommandBars("Add-Ins")
If cbMenu Is Nothing Then
'not available so we fail
Exit Function
End If
-
+
'add it to the command bar
Set cbMenuCommandBar = cbMenu.Controls.add(1)
c = cbMenu.Controls.count - 1
@@ -635,11 +635,10 @@ Function AddToAddInCommandBar(VBInst As Object, sCaption As String, oBitmap As O
Clipboard.SetData oBitmap
'set the icon for the button
cbMenuCommandBar.PasteFace
-
+
Set AddToAddInCommandBar = cbMenuCommandBar
-
+
Exit Function
AddToAddInCommandBarErr:
-
-End Function
+End Function