You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@openoffice.apache.org by pf...@apache.org on 2014/04/29 21:12:03 UTC
svn commit: r1591060 [5/15] - in /openoffice/trunk/main:
helpcontent2/source/text/scalc/01/ helpcontent2/source/text/shared/01/
helpcontent2/source/text/simpress/01/ helpcontent2/source/text/smath/01/
helpcontent2/source/text/swriter/01/ helpcontent2/s...
Modified: openoffice/trunk/main/migrationanalysis/src/driver_docs/sources/AnalysisDriver.bas
URL: http://svn.apache.org/viewvc/openoffice/trunk/main/migrationanalysis/src/driver_docs/sources/AnalysisDriver.bas?rev=1591060&r1=1591059&r2=1591060&view=diff
==============================================================================
--- openoffice/trunk/main/migrationanalysis/src/driver_docs/sources/AnalysisDriver.bas (original)
+++ openoffice/trunk/main/migrationanalysis/src/driver_docs/sources/AnalysisDriver.bas Tue Apr 29 19:11:53 2014
@@ -1,3639 +1,3639 @@
-Attribute VB_Name = "AnalysisDriver"
-'*************************************************************************
-'
-' 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
-' regarding copyright ownership. The ASF licenses this file
-' 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.
-'
-'*************************************************************************
-Option Explicit
-
-' Declare Public variables.
-Public Type ShortItemId
- cb As Long
- abID As Byte
-End Type
-
-Public Type ITEMIDLIST
- mkid As ShortItemId
-End Type
-
-Public Declare Function FindWindow Lib "user32" Alias _
- "FindWindowA" (ByVal lpClassName As String, _
- ByVal lpWindowName As Long) As Long
-
-Private Declare Function GetTickCount Lib "kernel32" () As Long
-
-'This function saves the passed value to the file,
-'under the section and key names specified.
-'If the ini file, lpFileName, does not exist, it is created.
-'If the section, lpSectionName, does not exist, it is created.
-'If the key name, lpKeyName, does not exist, it is created.
-'If the key name exists, it's value, lpString, is replaced.
-Private Declare Function WritePrivateProfileString Lib "kernel32" _
- Alias "WritePrivateProfileStringA" _
- (ByVal lpSectionName As String, _
- ByVal lpKeyName As Any, _
- ByVal lpString As Any, _
- ByVal lpFileName As String) As Long
-
-Private Declare Function GetPrivateProfileString Lib "kernel32" _
- Alias "GetPrivateProfileStringA" _
- (ByVal lpSectionName As String, _
- ByVal lpKeyName As Any, _
- ByVal lpDefault As String, _
- ByVal lpReturnedString As String, _
- ByVal nSize As Long, _
- ByVal lpFileName As String) As Long
-
-Private Declare Function UrlEscape Lib "shlwapi" _
- Alias "UrlEscapeA" _
- (ByVal pszURL As String, _
- ByVal pszEscaped As String, _
- pcchEscaped As Long, _
- ByVal dwFlags As Long) As Long
-
-Public Declare Function SHGetPathFromIDList Lib "shell32.dll" _
- (ByVal pidl As Long, ByVal pszPath As String) As Long
-
-Public Declare Function SHGetSpecialFolderLocation Lib _
- "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder _
- As Long, pidl As ITEMIDLIST) As Long
-
-Public Const LOCALE_ILANGUAGE As Long = &H1 'language id
-Public Const LOCALE_SLANGUAGE As Long = &H2 'localized name of lang
-Public Const LOCALE_SENGLANGUAGE As Long = &H1001 'English name of lang
-Public Const LOCALE_SABBREVLANGNAME As Long = &H3 'abbreviated lang name
-Public Const LOCALE_SNATIVELANGNAME As Long = &H4 'native name of lang
-Public Const LOCALE_ICOUNTRY As Long = &H5 'country code
-Public Const LOCALE_SCOUNTRY As Long = &H6 'localized name of country
-Public Const LOCALE_SENGCOUNTRY As Long = &H1002 'English name of country
-Public Const LOCALE_SABBREVCTRYNAME As Long = &H7 'abbreviated country name
-Public Const LOCALE_SNATIVECTRYNAME As Long = &H8 'native name of country
-Public Const LOCALE_SINTLSYMBOL As Long = &H15 'intl monetary symbol
-Public Const LOCALE_IDEFAULTLANGUAGE As Long = &H9 'def language id
-Public Const LOCALE_IDEFAULTCOUNTRY As Long = &HA 'def country code
-Public Const LOCALE_IDEFAULTCODEPAGE As Long = &HB 'def oem code page
-Public Const LOCALE_IDEFAULTANSICODEPAGE As Long = &H1004 'def ansi code page
-Public Const LOCALE_IDEFAULTMACCODEPAGE As Long = &H1011 'def mac code page
-
-Public Const LOCALE_IMEASURE As Long = &HD '0 = metric, 1 = US
-Public Const LOCALE_SSHORTDATE As Long = &H1F 'short date format string
-
-'#if(WINVER >= &H0400)
-Public Const LOCALE_SISO639LANGNAME As Long = &H59 'ISO abbreviated language name
-Public Const LOCALE_SISO3166CTRYNAME As Long = &H5A 'ISO abbreviated country name
-'#endif /* WINVER >= as long = &H0400 */
-
-'#if(WINVER >= &H0500)
-Public Const LOCALE_SNATIVECURRNAME As Long = &H1008 'native name of currency
-Public Const LOCALE_IDEFAULTEBCDICCODEPAGE As Long = &H1012 'default ebcdic code page
-Public Const LOCALE_SSORTNAME As Long = &H1013 'sort name
-'#endif /* WINVER >= &H0500 */
-
-Public Declare Function GetSystemDefaultLangID Lib "kernel32" () As Long
-Public Declare Function GetUserDefaultLangID Lib "kernel32" () As Long
-
-Public Declare Function GetLocaleInfo Lib "kernel32" _
- Alias "GetLocaleInfoA" _
- (ByVal Locale As Long, _
- ByVal LCType As Long, _
- ByVal lpLCData As String, _
- ByVal cchData As Long) As Long
-
-
-Public Const CWIZARD = "analysis"
-
-Const CROWOFFSET = 2
-Const CDOCPROP_PAW_ROWOFFSET = 3
-Private mDocPropRowOffset As Long
-
-Const CNUMBERDOC_ALL = "All"
-Const CTOTAL_DOCS_ANALYZED = "TotalDocsAnalysed"
-Const CNUMDAYS_IN_MONTH = 30
-Const CMAX_LIMIT = 10000
-
-Const CISSUE_DETDOCNAME = 1
-Const CISSUE_DETDOCAPPLICATION = CISSUE_DETDOCNAME + 1
-Const CISSUE_DETTYPE = CISSUE_DETDOCAPPLICATION + 1
-Const CISSUE_DETSUBTYPE = CISSUE_DETTYPE + 1
-Const CISSUE_DETLOCATION = CISSUE_DETSUBTYPE + 1
-Const CISSUE_DETSUBLOCATION = CISSUE_DETLOCATION + 1
-Const CISSUE_DETLINE = CISSUE_DETSUBLOCATION + 1
-Const CISSUE_DETCOLUMN = CISSUE_DETLINE + 1
-Const CISSUE_DETATTRIBUTES = CISSUE_DETCOLUMN + 1
-Const CISSUE_DETNAMEANDPATH = CISSUE_DETATTRIBUTES + 1
-
-Const CREF_DETDOCNAME = 1
-Const CREF_DETDOCAPPLICATION = CREF_DETDOCNAME + 1
-Const CREF_DETREFERENCE = CREF_DETDOCAPPLICATION + 1
-Const CREF_DETDESCRIPTION = CREF_DETREFERENCE + 1
-Const CREF_DETLOCATION = CREF_DETDESCRIPTION + 1
-Const CREF_DETATTRIBUTES = CREF_DETLOCATION + 1
-Const CREF_DETNAMEANDPATH = CREF_DETATTRIBUTES + 1
-
-Const CINPUT_DIR = "indir"
-Const COUTPUT_DIR = "outdir"
-Const CRESULTS_FILE = "resultsfile"
-Const CLOG_FILE = "logfile"
-Const CRESULTS_TEMPLATE = "resultstemplate"
-Const CRESULTS_EXIST = "resultsexist"
-Const COVERWRITE_FILE = "overwritefile"
-Const CNEW_RESULTS_FILE = "newresultsfile"
-Const CINCLUDE_SUBDIRS = "includesubdirs"
-Const CDEBUG_LEVEL = "debuglevel"
-Const COUTPUT_TYPE = "outputtype"
-Const COUTPUT_TYPE_XLS = "xls"
-Const COUTPUT_TYPE_XML = "xml"
-Const COUTPUT_TYPE_BOTH = "both"
-Const COVERVIEW_TITLE_LABEL = "OV_Document_Analysis_Overview_lbl"
-Const CDEFAULT_PASSWORD = "defaultpassword"
-Const CVERSION = "version"
-Const CTITLE = "title"
-Const CDOPREPARE = "prepare"
-Const CISSUES_LIMIT = "issuesmonthlimit"
-Const CSINGLE_FILE = "singlefile"
-Const CFILE_LIST = "filelist"
-Const CSTAT_FILE = "statfilename"
-Const C_ABORT_ANALYSIS = "abortanalysis"
-Const C_DOCS_LESS_3_MONTH = "DocumentsYoungerThan3Month"
-Const C_DOCS_LESS_6_MONTH = "DocumentsYoungerThan6Month"
-Const C_DOCS_LESS_12_MONTH = "DocumentsYoungerThan12Month"
-Const C_DOCS_MORE_12_MONTH = "DocumentsOlderThan12Month"
-
-Private Const C_ANALYSIS As String = "Analysis"
-Private Const C_LAST_CHECKPOINT As String = "LastCheckpoint"
-Private Const C_NEXT_FILE As String = "NextFile"
-Private Const C_MAX_CHECK_INI As String = "FilesBeforeSave"
-Private Const C_MAX_WAIT_BEFORE_WRITE_INI As String = "SecondsBeforeSave"
-Private Const C_MAX_RANGE_PROCESS_TIME_INI As String = "ExcelMaxRangeProcessTime"
-Private Const C_ERROR_HANDLING_DOC As String = "_ERROR_HANDLING_DOC_"
-Private Const C_MAX_CHECK As Long = 100
-Private Const C_MAX_WAIT_BEFORE_WRITE As Long = 300 ' sec
-Private Const C_MAX_RANGE_PROCESS_TIME As Integer = 30 'sec
-
-Private Const C_STAT_STARTING As Integer = 1
-Private Const C_STAT_DONE As Integer = 2
-Private Const C_STAT_FINISHED As Integer = 3
-
-Private Type DocumentCount
- numDocsAnalyzed As Long
- numDocsAnalyzedWithIssues As Long
- numMinorIssues As Long
- numComplexIssues As Long
- numMacroIssues As Long
- numPreparableIssues As Long
- totalMacroCosts As Long
- totalDocIssuesCosts As Long
- totalPreparableIssuesCosts As Long
-End Type
-
-Private Type DocModificationDates
- lessThanThreemonths As Long
- threeToSixmonths As Long
- sixToTwelvemonths As Long
- greaterThanOneYear As Long
-End Type
-
-Private Type DocMacroClassifications
- None As Long
- Simple As Long
- Medium As Long
- complex As Long
-End Type
-
-Private Type DocIssueClassifications
- None As Long
- Minor As Long
- complex As Long
-End Type
-
-Const CCOST_COL_OFFSET = -1
-
-Private mLogFilePath As String
-Private mDocIndex As String
-Private mDebugLevel As Long
-Private mIniFilePath As String
-Private mUserFormTypesDict As Scripting.Dictionary
-Private mIssuesDict As Scripting.Dictionary
-Private mMacroDict As Scripting.Dictionary
-Private mPreparedIssuesDict As Scripting.Dictionary
-Private mIssuesClassificationDict As Scripting.Dictionary
-Private mIssuesCostDict As Scripting.Dictionary
-Private mIssuesLimit As Date
-
-Public Const CWORD_DRIVER_FILE = "_OOoDocAnalysisWordDriver.doc"
-Public Const CEXCEL_DRIVER_FILE = "_OOoDocAnalysisExcelDriver.xls"
-Public Const CPP_DRIVER_FILE = "_OOoDocAnalysisPPTDriver.ppt"
-Public Const CWORD_DRIVER_FILE_TEMP = "~$OoDocAnalysisWordDriver.doc"
-Public Const CEXCEL_DRIVER_FILE_TEMP = "~$OoDocAnalysisExcelDriver.xls"
-Public Const CPP_DRIVER_FILE_TEMP = "~$OoDocAnalysisPPTDriver.ppt"
-
-'Doc Properties Offsets - used in WriteDocProperties and GetPreparableFilesFromDocProps
-Const CDOCINFONAME = 1
-Const CDOCINFOAPPLICATION = CDOCINFONAME + 1
-
-Const CDOCINFOISSUE_CLASS = CDOCINFOAPPLICATION + 1
-Const CDOCINFOCOMPLEXISSUES = CDOCINFOISSUE_CLASS + 1
-Const CDOCINFOMINORISSUES = CDOCINFOCOMPLEXISSUES + 1
-Const CDOCINFOPREPAREDISSUES = CDOCINFOMINORISSUES + 1
-
-Const CDOCINFOMACRO_CLASS = CDOCINFOPREPAREDISSUES + 1
-Const CDOCINFOMACRO_USERFORMS = CDOCINFOMACRO_CLASS + 1
-Const CDOCINFOMACRO_LINESOFCODE = CDOCINFOMACRO_USERFORMS + 1
-
-Const CDOCINFODOCISSUECOSTS = CDOCINFOMACRO_LINESOFCODE + 1
-Const CDOCINFOPREPARABLEISSUECOSTS = CDOCINFODOCISSUECOSTS + 1
-Const CDOCINFOMACROISSUECOSTS = CDOCINFOPREPARABLEISSUECOSTS + 1
-
-Const CDOCINFONUMBERPAGES = CDOCINFOMACROISSUECOSTS + 1
-Const CDOCINFOCREATED = CDOCINFONUMBERPAGES + 1
-Const CDOCINFOLASTMODIFIED = CDOCINFOCREATED + 1
-Const CDOCINFOLASTACCESSED = CDOCINFOLASTMODIFIED + 1
-Const CDOCINFOLASTPRINTED = CDOCINFOLASTACCESSED + 1
-Const CDOCINFOLASTSAVEDBY = CDOCINFOLASTPRINTED + 1
-Const CDOCINFOREVISION = CDOCINFOLASTSAVEDBY + 1
-Const CDOCINFOTEMPLATE = CDOCINFOREVISION + 1
-Const CDOCINFONAMEANDPATH = CDOCINFOTEMPLATE + 1
-
-'Overview shapes
-Const COV_DOC_MOD_DATES_CHART = "Chart 21"
-Const COV_DOC_MACRO_CHART = "Chart 22"
-Const COV_DOC_ANALYSIS_CHART = "Chart 23"
-
-Const COV_DOC_MOD_DATES_COMMENT_TXB = "Text Box 25"
-Const COV_DOC_MOD_DATES_LEGEND_TXB = "Text Box 12"
-
-Const COV_DOC_MACRO_COMMENT_TXB = "Text Box 26"
-Const COV_DOC_MACRO_LEGEND_TXB = "Text Box 16"
-
-Const COV_DOC_ANALYSIS_COMMENT_TXB = "Text Box 27"
-Const COV_DOC_ANALYSIS_LEGEND_DAW_TXB = "Text Box 28"
-Const COV_DOC_ANALYSIS_LEGEND_PAW_TXB = "Text Box 18"
-
-Const COV_HIGH_LEVEL_ANALYSIS_RANGE = "OV_High_Level_Analysis_Range"
-Const COV_COST_RANGE = "OV_Cost_Range"
-
-'Sheet labels
-Const COV_HIGH_LEVEL_ANALYSIS_LBL = "OV_High_level_analysis_lbl"
-Const COV_DP_PREPISSUES_COL_LBL = "DocProperties_PreparedIssues_Column"
-Const COV_COSTS_PREPISSUE_COUNT_COL_LBL = "Costs_PreparedIssueCount_Column"
-Const CDP_DAW_HIDDEN_COLS_LBL = "DP_DAW_HIDDEN_COLS_RANGE"
-Const CDP_DAW_HIDDEN_COLS2_LBL = "DP_DAW_HIDDEN_COLS_RANGE2"
-Const CDP_DAW_HIDDEN_ROW_LBL = "DP_DAW_HIDDEN_ROW_RANGE"
-
-Const COV_DAW_SETUP_SHEETS_RUN_LBL = "OV_DAW_SETUP_SHEETS_RUN"
-Const COV_PAW_SETUP_SHEETS_RUN_LBL = "OV_PAW_SETUP_SHEETS_RUN"
-Const COV_Internal_Attributes_Cols_LBL = "OV_Internal_Attributes_Cols"
-
-Const CR_STR = "<CR>"
-Const CR_TOPIC = "<TOPIC>"
-Const CR_PRODUCT = "<PRODUCT>"
-
-Const CLEGEND_FONT_SIZE = 8
-Const CCOMMENTS_FONT_SIZE = 10
-
-Dim mTstart As Single
-Dim mTend As Single
-Public gExcelMaxRangeProcessTime As Integer
-
-Sub AnalyseDirectory()
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "AnalyseDirectory"
-
- Dim iniFilePath As String
- Dim startDir As String
- Dim fileList As String
- Dim storeToDir As String
- Dim resultsFile As String
- Dim resultsTemplate As String
- Dim statFileName As String
- Dim bOverwriteResultsFile As Boolean
- Dim bNewResultsFile As Boolean
- Dim outputType As String
- Dim singleFile As String
- Dim nTimeNeeded As Long
- Dim nIncrementFileCounter As Long
- Dim nMaxWaitBeforeWrite As Long
- Dim fso As Scripting.FileSystemObject
- Set fso = New Scripting.FileSystemObject
-
- SetAppToMinimized
-
- If InDocPreparation Then
- mDocPropRowOffset = CDOCPROP_PAW_ROWOFFSET
- Else
- mDocPropRowOffset = CROWOFFSET
- End If
-
- 'Get Wizard input variables
- SetupWizardVariables fileList, storeToDir, resultsFile, _
- mLogFilePath, resultsTemplate, bOverwriteResultsFile, bNewResultsFile, _
- statFileName, mDebugLevel, outputType, singleFile
-
- startDir = ProfileGetItem("Analysis", CINPUT_DIR, "", mIniFilePath)
-
- nIncrementFileCounter = CLng(ProfileGetItem("Analysis", _
- C_MAX_CHECK_INI, C_MAX_CHECK, mIniFilePath))
- nMaxWaitBeforeWrite = CLng(ProfileGetItem("Analysis", _
- C_MAX_WAIT_BEFORE_WRITE_INI, C_MAX_WAIT_BEFORE_WRITE, mIniFilePath))
- gExcelMaxRangeProcessTime = CInt(ProfileGetItem("Analysis", _
- C_MAX_RANGE_PROCESS_TIME_INI, C_MAX_RANGE_PROCESS_TIME, mIniFilePath))
- LocalizeResources
-
- 'Setup File List
- 'For Prepare - get list from results spreadsheet with docs analysis found as preparable
- 'If no results spreadsheet then just try to prepare all the docs - run over full analysis list
- Dim myFiles As Collection
- Set myFiles = New Collection
- Dim sAnalysisOrPrep As String
- If InDocPreparation And CheckDoPrepare Then
- sAnalysisOrPrep = "Prepared"
- If fso.FileExists(storeToDir & "\" & resultsFile) Then
- If Not GetPrepareFilesToAnalyze(storeToDir & "\" & resultsFile, myFiles, fso) Then
- SetPrepareToNone
- WriteDebug currentFunctionName & ": No files to analyse!"
- GoTo FinalExit 'No files to prepare - exit
- End If
- Else
- If Not GetFilesToAnalyze(fileList, singleFile, myFiles) Then
- SetPrepareToNone
- WriteDebug currentFunctionName & ": No files to analyse! Filelist (" & fileList & ") empty?"
- GoTo FinalExit 'No files to prepare - exit
- End If
- End If
- Else
- sAnalysisOrPrep = "Analyzed"
- If Not GetFilesToAnalyze(fileList, singleFile, myFiles) Then
- WriteDebug currentFunctionName & ": No files to analyse! Filelist (" & fileList & ") empty?"
- GoTo FinalExit
- End If
- End If
-
- Dim index As Long
- Dim numFiles As Long
- Dim nextSave As Long
- Dim startIndex As Long
- Dim bResultsWaiting As Boolean
- Dim AnalysedDocs As Collection
- Dim startDate As Date
- Dim currentDate As Date
-
- Set AnalysedDocs = New Collection
- numFiles = myFiles.count
- bResultsWaiting = False
-
- If (singleFile <> "") Then
- ' No recovery handling for single file analysis and the value in the
- ' ini file should be used for bNewResultsFile
- startIndex = 1
- Else
- bNewResultsFile = bNewResultsFile And GetIndexValues(startIndex, nextSave, myFiles)
- End If
-
- startDate = Now()
-
- ' Analyse all files
- For index = startIndex To numFiles
- Set mIssuesClassificationDict = New Scripting.Dictionary
- 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
-
- If (CheckForAbort) Then GoTo FinalExit
-
- 'Log Analysis
- WriteToStatFile statFileName, C_STAT_STARTING, myFiles.item(index), fso
- 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
-
- WriteToLog sAnalysisOrPrep, index & "of" & numFiles & _
- " " & getAppSpecificApplicationName & " Documents"
- WriteToLog "Analyzing", "Done"
- WriteToLog sAnalysisOrPrep & "Doc" & index, myFiles.item(index)
- Set myAnalyser = Nothing
-
- If (CheckForAbort) Then GoTo FinalExit
-
- 'No need to output results spreadsheet, just doing prepare
- If CheckDoPrepare Then GoTo CONTINUE_FOR
-
- nTimeNeeded = val(DateDiff("s", startDate, Now()))
- If ((nTimeNeeded > nMaxWaitBeforeWrite) Or _
- (index >= nextSave)) Then
- If WriteResults(storeToDir, resultsFile, resultsTemplate, _
- bOverwriteResultsFile, bNewResultsFile, _
- outputType, AnalysedDocs, fso) Then
- nextSave = index + C_MAX_CHECK
- bResultsWaiting = False
- Set AnalysedDocs = New Collection
- WriteToIni C_LAST_CHECKPOINT, myFiles.item(index)
- startDate = Now()
- Else
- 'write error
- End If
- End If
- WriteToStatFile statFileName, C_STAT_DONE, myFiles.item(index), fso
-CONTINUE_FOR:
- Next index
-
- If (bResultsWaiting) Then
- If WriteResults(storeToDir, resultsFile, resultsTemplate, _
- bOverwriteResultsFile, bNewResultsFile, _
- outputType, AnalysedDocs, fso) Then
- WriteToIni C_LAST_CHECKPOINT, myFiles.item(index - 1)
- Else
- 'write error
- End If
- End If
- WriteToStatFile statFileName, C_STAT_FINISHED, "", fso
-
-FinalExit:
-
- Set fso = Nothing
- Set myFiles = Nothing
- Set mIssuesClassificationDict = Nothing
- Set mIssuesCostDict = Nothing
- Set mUserFormTypesDict = Nothing
- 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
-End Sub
-
-Function WriteResults(storeToDir As String, resultsFile As String, resultsTemplate As String, _
- bOverwriteResultsFile As Boolean, bNewResultsFile As Boolean, _
- outputType As String, AnalysedDocs As Collection, _
- fso As FileSystemObject) As Boolean
-
- 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
-
-FinalExit:
- Exit Function
-
-HandleErrors:
- WriteResults = False
- WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Function
-
-Function GetFilesToAnalyze_old(startDir As String, bIncludeSubdirs As Boolean, _
- myFiles As Collection) As Boolean
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "GetFilesToAnalyze"
- 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
- Set searchTypes = New Collection
- SetupSearchTypes searchTypes
- If searchTypes.count = 0 Then
- GoTo FinalExit
- End If
-
- Dim myDocFiles As CollectedFiles
- Set myDocFiles = New CollectedFiles
- With myDocFiles
- .BannedList.Add fso.GetAbsolutePathName(getAppSpecificPath & "\" & CWORD_DRIVER_FILE)
- .BannedList.Add fso.GetAbsolutePathName(getAppSpecificPath & "\" & CEXCEL_DRIVER_FILE)
- .BannedList.Add fso.GetAbsolutePathName(getAppSpecificPath & "\" & CPP_DRIVER_FILE)
- .BannedList.Add fso.GetAbsolutePathName(getAppSpecificPath & "\" & CWORD_DRIVER_FILE_TEMP)
- .BannedList.Add fso.GetAbsolutePathName(getAppSpecificPath & "\" & CEXCEL_DRIVER_FILE_TEMP)
- .BannedList.Add fso.GetAbsolutePathName(getAppSpecificPath & "\" & CPP_DRIVER_FILE_TEMP)
- .BannedList.Add theResultsFile
- End With
- myDocFiles.Search rootDir:=startDir, FileSpecs:=searchTypes, _
- IncludeSubdirs:=bIncludeSubdirs
-
- If getAppSpecificApplicationName = CAPPNAME_WORD Then
- Set myFiles = myDocFiles.WordFiles
- ElseIf getAppSpecificApplicationName = CAPPNAME_EXCEL Then
- Set myFiles = myDocFiles.ExcelFiles
- ElseIf getAppSpecificApplicationName = CAPPNAME_POWERPOINT Then
- Set myFiles = myDocFiles.PowerPointFiles
- Else
- 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)
- While (Not fileContent.AtEndOfStream)
- fileName = fileContent.ReadLine
- fileName = Trim(fileName)
- If (fileName <> "") Then
- myFiles.Add (fileName)
- End If
- Wend
- fileContent.Close
- End If
- Else
- myFiles.Add (startFile)
- End If
-
- If (myFiles.count <> 0) Then GetFilesToAnalyze = True
-
-FinalExit:
- Set fileContent = Nothing
- Set fso = Nothing
- Exit Function
-
-HandleErrors:
- WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Function
-
-Function GetPrepareFilesToAnalyze(resultsFilePath As String, myFiles As Collection, _
- fso As FileSystemObject) As Boolean
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- 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
- Set xl = Application
- xl.Visible = True
- Else
- Set xl = GetExcelInstance
- xl.Visible = False
- 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)
-
- Dim startRow As Long
- 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
- xl.Quit
- End If
- End If
- End If
- Set xl = Nothing
-
- Exit Function
-
-HandleErrors:
- WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Function
-
-Function GetPreparableFilesFromDocProps(wsDocProp As Worksheet, startRow As Long, _
- endRow As Long, fso As FileSystemObject, myFiles As Collection) As Boolean
- On Error GoTo HandleErrors
- 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)
- fileExt = "." & fso.GetExtensionName(fileName)
- 'Don't have to worry about search types - just looking at existing results
- 'so just check both legal extensions for this application
- If fileExt = docExt Or fileExt = templateExt Then
- myFiles.Add GetWorksheetCellValueAsString(wsDocProp, index, CDOCINFONAMEANDPATH)
- End If
- End If
- Next index
-
- GetPreparableFilesFromDocProps = myFiles.count > 0
-FinalExit:
- Exit Function
-
-HandleErrors:
- GetPreparableFilesFromDocProps = False
- WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Function
-
-Sub OpenXLSResultFile(resultsFile As String, _
- resultsTemplate As String, _
- bNewResultsFile As Boolean, _
- excelApp As Excel.Application, _
- resultSheet As Excel.WorkBook)
-
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "OpenXLSResultFile"
-
- If getAppSpecificApplicationName = CAPPNAME_EXCEL Then
- Set excelApp = Application
- excelApp.Visible = True
- Else
- Set excelApp = GetExcelInstance
- excelApp.Visible = False
- End If
-
- If bNewResultsFile Then
- Set resultSheet = excelApp.Workbooks.Add(Template:=resultsTemplate)
- Localize_WorkBook resultSheet
- Else
- Set resultSheet = excelApp.Workbooks.Open(resultsFile)
- End If
-
-FinalExit:
- Exit Sub
-
-HandleErrors:
- excelApp.DisplayAlerts = False
- WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-
-Sub CloseXLSResultFile(excelApp As Excel.Application, _
- resultSheet As Excel.WorkBook)
-
- On Error Resume Next
-
- If Not resultSheet Is Nothing Then resultSheet.Close
- Set resultSheet = Nothing
-
- If getAppSpecificApplicationName <> CAPPNAME_EXCEL Then
- If Not excelApp Is Nothing Then
- excelApp.Visible = True
- If excelApp.Workbooks.count = 0 Then
- excelApp.Quit
- End If
- End If
- End If
- Set excelApp = Nothing
-
- Exit Sub
-End Sub
-
-Sub WriteXLSOutput(storeToDir As String, resultsFile As String, resultsTemplate As String, _
- bOverwriteResultsFile As Boolean, bNewResultsFile As Boolean, AnalysedDocs As Collection, _
- fso As Scripting.FileSystemObject)
-
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "WriteXLSOutput"
-
- Dim offsetDocPropRow As Long
- Dim offsetDocIssuesRow As Long
- Dim offsetDocIssueDetailsRow As Long
- Dim offsetDocRefDetailsRow As Long
-
- Const COVERVIEW_SHEET_IDX = 1
- Const CDOCLIST_SHEET_IDX = 2
- Const CISSUES_ANALYSED_SHEET = 3
- Const CISSUE_DETAILS_SHEET = 4
- Const CWORD_ISSUES_SHEET = 5
- Const CEXCEL_ISSUES_SHEET = 6
- Const CPOWERPOINT_ISSUES_SHEET = 7
- Const CREFERENCE_ISSUES_SHEET = 8
-
- 'Begin writing stats to excel
- Dim xl As Excel.Application
- If getAppSpecificApplicationName = CAPPNAME_EXCEL Then
- Set xl = Application
- xl.Visible = True
- Else
- Set xl = GetExcelInstance
- xl.Visible = False
- End If
-
- Dim logWb As WorkBook
-
- If bNewResultsFile Then
- Set logWb = xl.Workbooks.Add(Template:=resultsTemplate)
- Localize_WorkBook logWb
- Else
- Set logWb = xl.Workbooks.Open(storeToDir & "\" & resultsFile)
- End If
-
- SetupAnalysisResultsVariables logWb, offsetDocPropRow, _
- offsetDocIssuesRow, offsetDocIssueDetailsRow, offsetDocRefDetailsRow
-
- ' Iterate through results and write info
- Dim aAnalysis As DocumentAnalysis
- Dim row As Long
- Dim docCounts As DocumentCount
- Dim templateCounts As DocumentCount
-
- Dim issuesRow As Long
- Dim issueDetailsRow As Long
- Dim refDetailsRow As Long
-
- Dim wsOverview As Worksheet
- Dim wsCosts As Worksheet
- Dim wsPgStats As Worksheet
- Dim wsIssues As Worksheet
- Dim wsIssueDetails As Worksheet
- Dim wsRefDetails As Worksheet
-
- Set wsOverview = logWb.Sheets(COVERVIEW_SHEET_IDX)
- Set wsPgStats = logWb.Sheets(CDOCLIST_SHEET_IDX)
-
- 'Some localized names might be longer than 31 chars, excel doesn't
- 'allow such names!
- On Error Resume Next
- wsOverview.name = RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW
- wsPgStats.name = RID_STR_COMMON_RESULTS_SHEET_NAME_DOCPROP
- On Error GoTo HandleErrors
-
- If InDocPreparation Then
- Set wsCosts = logWb.Sheets(CISSUES_ANALYSED_SHEET)
- Dim appName As String
- appName = getAppSpecificApplicationName
- Select Case appName
- Case "Word"
- Set wsIssues = logWb.Worksheets(CWORD_ISSUES_SHEET)
- Case "Excel"
- Set wsIssues = logWb.Worksheets(CEXCEL_ISSUES_SHEET)
- Case "PowerPoint"
- Set wsIssues = logWb.Worksheets(CPOWERPOINT_ISSUES_SHEET)
- Case Default
- Err.Raise Number:=-1, Description:="BadAppName"
- End Select
- Set wsIssueDetails = logWb.Sheets(CISSUE_DETAILS_SHEET)
- Set wsRefDetails = logWb.Sheets(CREFERENCE_ISSUES_SHEET)
- issuesRow = 1 + CROWOFFSET + offsetDocIssuesRow
- issueDetailsRow = 1 + CROWOFFSET + offsetDocIssueDetailsRow
- refDetailsRow = 1 + CROWOFFSET + offsetDocRefDetailsRow
- ' localize PAW worksheets
- Dim wsWordIssues As Worksheet
- Dim wsExcelIssues As Worksheet
- Dim wsPowerPointIssues As Worksheet
- Set wsWordIssues = logWb.Worksheets(CWORD_ISSUES_SHEET)
- Set wsExcelIssues = logWb.Worksheets(CEXCEL_ISSUES_SHEET)
- Set wsPowerPointIssues = logWb.Worksheets(CPOWERPOINT_ISSUES_SHEET)
-
- On Error Resume Next
- wsCosts.name = RID_STR_COMMON_RESULTS_SHEET_NAME_COSTS
- wsIssueDetails.name = RID_STR_COMMON_RESULTS_SHEET_NAME_DOCISSUE_DETAILS
- wsRefDetails.name = RID_STR_COMMON_RESULTS_SHEET_NAME_DOCREF_DETAILS
- wsWordIssues.name = RID_STR_COMMON_RESULTS_SHEET_NAME_DOCISSUES_WORD
- wsExcelIssues.name = RID_STR_COMMON_RESULTS_SHEET_NAME_DOCISSUES_EXCEL
- wsPowerPointIssues.name = RID_STR_COMMON_RESULTS_SHEET_NAME_DOCISSUES_POWERPOINT
- On Error GoTo HandleErrors
- End If
-
- Dim fileName As String
- Dim macroClasses As DocMacroClassifications
- Dim issueClasses As DocIssueClassifications
-
- For row = 1 To AnalysedDocs.count 'Need Row count - so not using Eor Each
- Set aAnalysis = AnalysedDocs.item(row)
- fileName = fso.GetFileName(aAnalysis.name)
-
- If InDocPreparation Then
- issuesRow = WriteDocIssues(wsIssues, issuesRow, aAnalysis, fileName)
- issueDetailsRow = _
- ProcessIssuesAndWriteDocIssueDetails(logWb, wsIssueDetails, issueDetailsRow, aAnalysis, fileName)
- refDetailsRow = _
- WriteDocRefDetails(wsRefDetails, refDetailsRow, aAnalysis, fileName)
- aAnalysis.MacroCosts = getMacroIssueCosts(logWb, aAnalysis)
- WriteDocProperties wsPgStats, row + offsetDocPropRow, aAnalysis, fileName
- Else
- 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
- Dim langStr As String
- Dim userLCID As Long
- Dim textSize As Long
- Dim fontName As String
-
- userLCID = GetUserDefaultLangID()
- langStr = GetUserLocaleInfo(userLCID, LOCALE_SISO639LANGNAME)
-
- If (langStr = "ja") Then
- WriteDebug currentFunctionName & " : Setting font to MS PGothic for 'ja' locale"
- fontName = "MS PGothic"
- textSize = 10
- Else
- fontName = "Arial"
- textSize = CLEGEND_FONT_SIZE
- End If
-
- 'DAW - PAW switches
- If InDocPreparation Then
- SaveAnalysisResultsVariables logWb, issueDetailsRow - (1 + CROWOFFSET), _
- refDetailsRow - (1 + CROWOFFSET)
-
- WriteOverview logWb, docCounts, templateCounts, macroClasses, issueClasses
-
- SetupPAWResultsSpreadsheet logWb, fontName, textSize
- WriteIssueCounts logWb
- Else
- WriteOverview logWb, docCounts, templateCounts, macroClasses, issueClasses
-
- 'StartTiming
- SetupDAWResultsSpreadsheet logWb, fontName, textSize
- 'EndTiming "SetupDAWResultsSpreadsheet"
- 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
-
-FinalExit:
- If Not xl Is Nothing Then
- xl.Visible = True
- End If
-
- Set wsOverview = Nothing
- Set wsPgStats = Nothing
-
- If InDocPreparation Then
- Set wsCosts = Nothing
- Set wsIssues = Nothing
- 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
- xl.Quit
- End If
- End If
- End If
- Set xl = Nothing
-
- Exit Sub
-
-HandleErrors:
- xl.DisplayAlerts = False
-
- WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-
-Public Sub StartTiming()
- mTstart = 0
- mTend = 0
- mTstart = GetTickCount()
-End Sub
-Public Sub EndTiming(what As String)
- mTend = GetTickCount()
- WriteDebug "Timing: " & what & ": " & (FormatNumber((mTend - mTstart) / 1000, 0) & " seconds")
- mTstart = 0
- mTend = 0
-End Sub
-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
- Dim count As Long
- Dim vKeyArray As Variant
- 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)
- val1 = CInt(vItemArray(count))
- logWb.Names(str1).RefersToRange.Cells(1, 1) = _
- 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)
- val1 = CInt(vPrepItemArray(count))
- 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 & "_" & _
- CSTR_SUBISSUE_PROPERTIES & "_" & _
- CSTR_SUBISSUE_VBA_MACROS_USERFORMS_CONTROLTYPE_COUNT
- SetWorkbookNameValueToLong logWb, str1, mUserFormTypesDict.count
-
- 'Add list of User Form controls and counts to ...USERFORMS_CONTROLTYPE_COUNT field
- 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)
- Next count
- WriteUserFromControlTypesComment logWb, str1, Str
- End If
- 'DEBUG: MsgBox str & vbLf & mIssuesDict.count
-
- WriteUniqueModuleCount logWb
-
-FinalExit:
- Exit Sub
-
-HandleErrors:
- WriteDebug currentFunctionName & _
- " : logging costs : " & _
- Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-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 & "_" & _
- CSTR_SUBISSUE_VBA_MACROS_UNIQUE_MODULE_COUNT
- SetWorkbookNameValueToLong logWb, strLabel, uniqueModuleCount
-
- strLabel = getAppSpecificApplicationName & "_" & _
- CSTR_ISSUE_VBA_MACROS & "_" & _
- CSTR_SUBISSUE_PROPERTIES & "_" & _
- CSTR_SUBISSUE_VBA_MACROS_UNIQUE_LINE_COUNT
- SetWorkbookNameValueToLong logWb, strLabel, uniqueLineCount
-
-FinalExit:
- Exit Sub
-
-HandleErrors:
- WriteDebug currentFunctionName & _
- " : logging Unique Module/ Line Counts : " & _
- Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-
-Sub WriteUserFromControlTypesComment(logWb As WorkBook, name As String, comment As String)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "WriteUserFromControlTypesComment"
-
- 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
- 'logWb.Names(name).RefersToRange.Cells(1, 1).comment.AutoSize = True
- logWb.Names(name).RefersToRange.Cells(1, 1).comment.Visible = False
-
-FinalExit:
- Exit Sub
-
-HandleErrors:
- WriteDebug currentFunctionName & _
- " : name : " & name & _
- " : comment : " & comment & _
- Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-
-Sub UpdateAllCounts(aAnalysis As DocumentAnalysis, counts As DocumentCount, templateCounts As DocumentCount, _
- macroClasses As DocMacroClassifications, issueClasses As DocIssueClassifications, _
- fso As FileSystemObject)
- Const CMODDATE_LESS3MONTHS = 91
- Const CMODDATE_LESS6MONTHS = 182
- Const CMODDATE_LESS12MONTHS = 365
-
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "UpdateAllCounts"
- 'DocIssue Classification occurs in setDocOverallIssueClassification under
- ' 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
- macroClasses.complex = macroClasses.complex + 1
- Case enMacroMedium
- macroClasses.Medium = macroClasses.Medium + 1
- Case enMacroSimple
- macroClasses.Simple = macroClasses.Simple + 1
- Case Else
- macroClasses.None = macroClasses.None + 1
- End Select
-
- 'DocIssueClassifications
- aAnalysis.BelowIssuesLimit = True
- Select Case aAnalysis.DocOverallIssueClass
- Case enComplex
- issueClasses.complex = issueClasses.complex + 1
- Case enMinor
- issueClasses.Minor = issueClasses.Minor + 1
- Case Else
- issueClasses.None = issueClasses.None + 1
- End Select
-
- 'DocumentCounts
- Dim extStr As String
- extStr = "." & LCase(fso.GetExtensionName(aAnalysis.name))
- If extStr = getAppSpecificDocExt Then
- UpdateDocCounts counts, aAnalysis
- ElseIf extStr = getAppSpecificTemplateExt Then
- UpdateDocCounts templateCounts, aAnalysis
- Else
- 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
-End Sub
-Sub UpdateDocCounts(counts As DocumentCount, aAnalysis As DocumentAnalysis)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "UpdateDocCounts"
-
- 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
- 'MinorIssuesCount incemented as all DocIssues are being traversed are being written out - ProcessIssuesAndWriteDocIssueDetails
- counts.numComplexIssues = counts.numComplexIssues + aAnalysis.ComplexIssuesCount 'Calculated
- counts.totalDocIssuesCosts = counts.totalDocIssuesCosts + _
- aAnalysis.DocIssuesCosts
- 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
-End Sub
-
-
-Sub WriteDocProperties(wsPgStats As Worksheet, row As Long, aAnalysis As DocumentAnalysis, _
- fileName As String)
- 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
- SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFONAMEANDPATH, aAnalysis.name
- Else
- SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFONAME, fileName
- SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOAPPLICATION, aAnalysis.Application
- SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOISSUE_CLASS, _
- getDocOverallIssueClassificationAsString(aAnalysis.DocOverallIssueClass)
- SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOMACRO_CLASS, _
- getDocOverallMacroClassAsString(aAnalysis.MacroOverallClass)
- 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
-End Sub
-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
-End Function
-
-Function WriteDocIssues(wsIssues As Worksheet, row As Long, _
- aAnalysis As DocumentAnalysis, fileName As String) As Long
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "WriteDocIssues"
-
- Const CNAME = 1
- Const CAPPLICATION = CNAME + 1
- Const CISSUE_COLUMNOFFSET = CAPPLICATION
-
- If aAnalysis.IssuesCount = 0 Then
- WriteDocIssues = row
- Exit Function
- 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
- SetWorksheetCellValueToString wsIssues, row, CISSUE_COLUMNOFFSET + index, aAnalysis.IssuesCountArray(index)
- 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
-End Function
-Sub ProcessIssuesForDAW(logWb As WorkBook, aAnalysis As DocumentAnalysis, fileName As String)
- 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
-End Sub
-
-Function ProcessIssuesAndWriteDocIssueDetails(logWb As WorkBook, wsIssueDetails As Worksheet, DetailsRow As Long, _
- aAnalysis As DocumentAnalysis, fileName As String) As Long
- 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
- issueClass = getDocIssueClassification(logWb, myIssue)
- CountDocIssuesForDoc issueClass, aAnalysis
- SetOverallDocIssueClassification issueClass, aAnalysis
- issueCost = getDocIssueCost(logWb, aAnalysis, myIssue)
- aAnalysis.DocIssuesCosts = aAnalysis.DocIssuesCosts + issueCost
- If myIssue.Preparable Then
- 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
-End Function
-
-Function getDocIssueCost(logWb As WorkBook, aAnalysis As DocumentAnalysis, myIssue As IssueInfo) As Long
- 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
- Resume FinalExit
-End Function
-Function getMacroIssueCosts(logWb As WorkBook, aAnalysis As DocumentAnalysis) As Long
- 'Error handling not required
- 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
- Const CMACRO_ROW_OFFSET_UNIQUE_LINES_COST = 4
- 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 * _
- getValueFromXLSorDict(logWb, aAnalysis, mIssuesCostDict, _
- baseIssueKey & CMACRO_NUM_OF_LINES_FACTOR_KEY, baseIssueKey, _
- CMACRO_ROW_OFFSET_UNIQUE_LINES_COST, CCOST_COL_OFFSET)
- End If
- 'User Forms Count
- If aAnalysis.MacroNumUserForms > 0 Then
- ret = ret + aAnalysis.MacroNumUserForms * _
- getValueFromXLSorDict(logWb, aAnalysis, mIssuesCostDict, _
- baseIssueKey & CMACRO_USER_FORMS_COUNT_FACTOR_KEY, baseIssueKey, _
- CMACRO_ROW_OFFSET_USER_FORMS_COUNT_COST, CCOST_COL_OFFSET)
- End If
- 'User Forms Control Count
- If aAnalysis.MacroNumUserFormControls > 0 Then
- ret = ret + aAnalysis.MacroNumUserFormControls * _
- getValueFromXLSorDict(logWb, aAnalysis, mIssuesCostDict, _
- baseIssueKey & CMACRO_USER_FORMS_CONTROL_COUNT_FACTOR_KEY, baseIssueKey, _
- CMACRO_ROW_OFFSET_USER_FORMS_CONTROL_COUNT_COST, CCOST_COL_OFFSET)
- End If
- 'User Forms Control Type Count
- If aAnalysis.MacroNumUserFormControlTypes > 0 Then
- 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
- Resume FinalExit
-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
- ret = ret + aAnalysis.MacroNumExternalRefs * _
- getValueFromXLSorDict(logWb, aAnalysis, mIssuesCostDict, _
- baseIssueKey & CMACRO_NUM_EXTERNAL_REFS_FACTOR_KEY, baseIssueKey, _
- CMACRO_ROW_OFFSET_NUM_EXTERNAL_REFS_COST, CCOST_COL_OFFSET)
-
-FinalExit:
- getMacroExtRefIssueCost = ret
- Exit Function
-
-HandleErrors:
- ret = 0
- WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Function
-Function getIssueValueFromXLSorDict(logWb As WorkBook, aAnalysis As DocumentAnalysis, dict As Scripting.Dictionary, _
- key As String, row As Long, column As Long) As Long
- 'Error handling not required
- getIssueValueFromXLSorDict = getValueFromXLSorDict(logWb, aAnalysis, dict, key, key, row, column)
-End Function
-
-Function getValueFromXLSorDict(logWb As WorkBook, aAnalysis As DocumentAnalysis, dict As Scripting.Dictionary, _
- dictKey As String, xlsKey As String, row As Long, column As Long) As Long
- 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
- On Error Resume Next
- ret = logWb.Names(xlsKey).RefersToRange.Cells(row, column).value
- 'Log as error missing key
- If Err.Number <> 0 Then
- WriteDebug currentFunctionName & _
- " : Issue Cost Key - " & xlsKey & ": label missing from results.xlt Costs sheet, check sheet and add/ check spelling label" & Err.Number & " " & Err.Description & " " & Err.Source
- WriteDebug currentFunctionName & " : dictKey " & dictKey & " : xlsKey " & xlsKey & " : " & Err.Number & " " & Err.Description & " " & Err.Source
- ret = 0
- End If
- On Error GoTo HandleErrors
- dict.Add dictKey, ret
- End If
-
-FinalExit:
- getValueFromXLSorDict = ret
- Exit Function
-
-HandleErrors:
- ret = 0
- WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-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
- isMacroIssue = True
- End If
-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
- ' Macro issues are counted during analysis
- ' Complex issues is calculated from: mIssues.count - mMinorIssuesCount - mMacroIssuesCount
-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
- aAnalysis.DocOverallIssueClass = enMinor
- End If
-End Sub
-Function getDocIssueClassification(logWb As WorkBook, myIssue As IssueInfo) As EnumDocOverallIssueClass
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "getDocIssueClassification"
- Dim issueKey As String
- Dim bRet As Boolean
- bRet = False
- getDocIssueClassification = enMinor
-
- issueKey = getAppSpecificApplicationName & "_" & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML
- If mIssuesClassificationDict.Exists(issueKey) Then
- bRet = mIssuesClassificationDict.item(issueKey)
- Else
- On Error Resume Next
- bRet = logWb.Names(issueKey).RefersToRange.Cells(1, 0).value
- 'Log as error missing key
- If Err.Number <> 0 Then
- WriteDebug currentFunctionName & _
- " : Issue Cost Key - " & issueKey & ": label missing from results.xlt Costs sheet, check sheet and add/ check spelling label" & Err.Number & " " & Err.Description & " " & Err.Source
- bRet = False
- End If
- On Error GoTo HandleErrors
- mIssuesClassificationDict.Add issueKey, bRet
- End If
-
-
-FinalExit:
- If bRet Then
- getDocIssueClassification = enComplex
- End If
- Exit Function
-
-HandleErrors:
- bRet = False
- WriteDebug currentFunctionName & " : issueKey " & issueKey & ": " & Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-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
- Case enMinor
- Str = RID_STR_COMMON_ISSUE_CLASS_MINOR
- 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
- Case enMacroMedium
- Str = RID_STR_COMMON_MACRO_CLASS_MEDIUM
- Case enMacroSimple
- Str = RID_STR_COMMON_MACRO_CLASS_SIMPLE
- Case Else
- Str = RID_STR_COMMON_MACRO_CLASS_NONE
- End Select
-
- getDocOverallMacroClassAsString = Str
-End Function
-
-Function WriteDocRefDetails(wsRefDetails As Worksheet, DetailsRow As Long, _
- aAnalysis As DocumentAnalysis, fileName As String) 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
- Set myIssue = aAnalysis.References(index)
- OutputReferenceAttributes wsRefDetails, rowIndex, aAnalysis, myIssue, fileName
- rowIndex = rowIndex + 1
- Set myIssue = Nothing
- Next index
- End If
-
- WriteDocRefDetails = rowIndex
-
-FinalExit:
- Exit Function
-
-HandleErrors:
- WriteDebug currentFunctionName & _
- " : path " & aAnalysis.name & ": " & _
- " : row " & DetailsRow & ": " & _
- Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Function
-Sub OutputReferenceAttributes(wsIssueDetails As Worksheet, rowIndex As Long, _
- aAnalysis As DocumentAnalysis, myIssue As IssueInfo, fileName As String)
- 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)
- Else
- 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 & ": " & _
- .Values(RID_STR_COMMON_ATTRIBUTE_BUILTIN) & " " & .Values(RID_STR_COMMON_ATTRIBUTE_ISBROKEN)
- strAttributes = IIf(.Values(RID_STR_COMMON_ATTRIBUTE_GUID) <> "", _
- 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 & ": " & _
- " : rowIndex " & rowIndex & ": " & _
- " : myIssue " & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML & ": " & _
- Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-Sub OutputCommonIssueAttributes(wsIssueDetails As Worksheet, rowIndex As Long, _
- myIssue As IssueInfo)
- 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 & ": " & _
- " : myIssue " & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML & ": " & _
- Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-'Store issue cost and factor costs across all documents
-Sub CollateIssueAndFactorCountsAcrossAllDocs(aAnalysis As DocumentAnalysis, myIssue As IssueInfo, fileName As String)
- Const CSTR_USER_FORM = "User Form"
- 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"
- End If
-
- '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 & ": " & _
- " : myIssue " & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML & ": " & _
- Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-
-Sub OutputCommonIssueDetails(wsIssueDetails As Worksheet, rowIndex As Long, _
- aAnalysis As DocumentAnalysis, myIssue As IssueInfo, fileName As String)
- Const CSTR_USER_FORM = "User Form"
- 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
- SetWorksheetCellValueToString wsIssueDetails, rowIndex, CISSUE_DETSUBTYPE, myIssue.SubType
- SetWorksheetCellValueToString wsIssueDetails, rowIndex, CISSUE_DETLOCATION, myIssue.Location
- SetWorksheetCellValueToString wsIssueDetails, rowIndex, CISSUE_DETSUBLOCATION, _
- IIf(myIssue.SubLocation = "", RID_STR_COMMON_NA, myIssue.SubLocation)
- SetWorksheetCellValueToVariant wsIssueDetails, rowIndex, CISSUE_DETLINE, _
- IIf(myIssue.Line = -1, RID_STR_COMMON_NA, myIssue.Line)
- SetWorksheetCellValueToString wsIssueDetails, rowIndex, CISSUE_DETCOLUMN, _
- IIf(myIssue.column = "", RID_STR_COMMON_NA, myIssue.column)
- SetWorksheetCellValueToString wsIssueDetails, rowIndex, CISSUE_DETNAMEANDPATH, aAnalysis.name
-
-
-FinalExit:
- Exit Sub
-
-HandleErrors:
- WriteDebug currentFunctionName & _
- " : path " & aAnalysis.name & ": " & _
- " : rowIndex " & rowIndex & ": " & _
- " : myIssue " & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML & ": " & _
- Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-
-Sub AddIssueAndBoolValToDict(issueKey As String, issue As IssueInfo, valKey As String)
- 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)
- Else
- mIssuesDict.Add issueKey, IIf(issue.Values(valKey) > 0, 1, 0)
- End If
-FinalExit:
- Exit Sub
-
-HandleErrors:
- WriteDebug currentFunctionName & _
- " : issueKey " & issueKey & ": " & _
- " : valKey " & valKey & ": " & _
- Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-Sub AddIssueAndValToDict(issueKey As String, issue As IssueInfo, valKey As String)
- 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
- mIssuesDict.Add issueKey, issue.Values(valKey)
- End If
-FinalExit:
- Exit Sub
-
-HandleErrors:
- WriteDebug currentFunctionName & _
- " : issueKey " & issueKey & ": " & _
- " : valKey " & valKey & ": " & _
- Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-
-Sub AddMacroModuleHashToMacroDict(issue As IssueInfo)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- 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 & ": " & _
- Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-
-Sub AddIssueAndOneToDict(key As String)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "AddIssueAndOneToDict"
-
- If mIssuesDict.Exists(key) Then
- mIssuesDict.item(key) = mIssuesDict.item(key) + 1
- Else
- mIssuesDict.Add key, 1
- End If
-FinalExit:
- Exit Sub
-
-HandleErrors:
- WriteDebug currentFunctionName & " : key " & key & ": " & Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-
-Sub AddPreparedIssueAndOneToDict(key As String)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "AddPreparedIssueAndOneToDict"
-
- If mPreparedIssuesDict.Exists(key) Then
- mPreparedIssuesDict.item(key) = mPreparedIssuesDict.item(key) + 1
- Else
- mPreparedIssuesDict.Add key, 1
- End If
-FinalExit:
- Exit Sub
-
-HandleErrors:
- WriteDebug currentFunctionName & " : key " & key & ": " & Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-
-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
- Set xl = GetObject(, "Excel.Application")
- If Err.Number = 429 Then
- Set xl = CreateObject("Excel.Application")
- ElseIf Err.Number <> 0 Then
- Set xl = Nothing
- MsgBox "Error: " & Err.Description
- Exit Function
- End If
- Set GetExcelInstance = xl
- Set xl = Nothing
-FinalExit:
- Exit Function
-
-HandleErrors:
- WriteDebug currentFunctionName & ": " & Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Function
-
-Sub WriteOverview(logWb As WorkBook, DocCount As DocumentCount, templateCount As DocumentCount, _
- macroClasses As DocMacroClassifications, issueClasses As DocIssueClassifications)
- 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)
-
- SetWorkbookNameValueToLong logWb, COV_MODDATES_LESS3MONTHS, modDates.lessThanThreemonths
- SetWorkbookNameValueToLong logWb, COV_MODDATES_3TO6MONTHS, modDates.threeToSixmonths
- SetWorkbookNameValueToLong logWb, COV_MODDATES_6TO12MONTHS, modDates.sixToTwelvemonths
- SetWorkbookNameValueToLong logWb, COV_MODDATES_MORE12MONTHS, modDates.greaterThanOneYear
-
-
- If InDocPreparation Then
- 'OV - Document Migration Issues(excludes macro issues)
- AddLongToWorkbookNameValue logWb, appName & "_" & COV_ISSUECOUNT_COMPLEX, _
- 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
-End Sub
-
-Sub SetupDAWResultsSpreadsheet(logWb As WorkBook, fontName As String, fontSize As Long)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- 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, _
- CCOMMENTS_FONT_SIZE, fontName
- 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
- SetupSheetTextBox logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_MACRO_COMMENT_TXB, _
- RID_STR_COMMON_OV_DOC_MACRO_COMMENT_TITLE, RID_STR_COMMON_OV_DOC_MACRO_COMMENT_BODY, _
- CCOMMENTS_FONT_SIZE, fontName
- SetupSheetTextBox logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_MACRO_LEGEND_TXB, _
- RID_STR_COMMON_OV_LEGEND_TITLE, RID_STR_COMMON_OV_DOC_MACRO_LEGEND_BODY, fontSize, fontName
- Dim monthLimit As Long
- monthLimit = GetIssuesLimitInDays / CNUMDAYS_IN_MONTH
- SetWorkbookNameValueToString logWb, COV_HIGH_LEVEL_ANALYSIS_LBL, _
- 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
- SetupSheetTextBox logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_ANALYSIS_LEGEND_DAW_TXB, _
- RID_STR_COMMON_OV_LEGEND_TITLE, RID_STR_COMMON_OV_DOC_ANALYSIS_DAW_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
- SetupSheetChartTitles logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_MACRO_CHART, _
- 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
-End Sub
-
-Sub SetupPAWResultsSpreadsheet(logWb As WorkBook, fontName As String, fontSize As Long)
[... 5098 lines stripped ...]