1cdf0e10cSrcweirAttribute VB_Name = "AnalysisDriver" 2*e76eebc6SAndrew Rist'************************************************************************* 3cdf0e10cSrcweir' 4*e76eebc6SAndrew Rist' Licensed to the Apache Software Foundation (ASF) under one 5*e76eebc6SAndrew Rist' or more contributor license agreements. See the NOTICE file 6*e76eebc6SAndrew Rist' distributed with this work for additional information 7*e76eebc6SAndrew Rist' regarding copyright ownership. The ASF licenses this file 8*e76eebc6SAndrew Rist' to you under the Apache License, Version 2.0 (the 9*e76eebc6SAndrew Rist' "License"); you may not use this file except in compliance 10*e76eebc6SAndrew Rist' with the License. You may obtain a copy of the License at 11cdf0e10cSrcweir' 12*e76eebc6SAndrew Rist' http://www.apache.org/licenses/LICENSE-2.0 13cdf0e10cSrcweir' 14*e76eebc6SAndrew Rist' Unless required by applicable law or agreed to in writing, 15*e76eebc6SAndrew Rist' software distributed under the License is distributed on an 16*e76eebc6SAndrew Rist' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 17*e76eebc6SAndrew Rist' KIND, either express or implied. See the License for the 18*e76eebc6SAndrew Rist' specific language governing permissions and limitations 19*e76eebc6SAndrew Rist' under the License. 20cdf0e10cSrcweir' 21*e76eebc6SAndrew Rist'************************************************************************* 22cdf0e10cSrcweirOption Explicit 23cdf0e10cSrcweir 24cdf0e10cSrcweir' Declare Public variables. 25cdf0e10cSrcweirPublic Type ShortItemId 26cdf0e10cSrcweir cb As Long 27cdf0e10cSrcweir abID As Byte 28cdf0e10cSrcweirEnd Type 29cdf0e10cSrcweir 30cdf0e10cSrcweirPublic Type ITEMIDLIST 31cdf0e10cSrcweir mkid As ShortItemId 32cdf0e10cSrcweirEnd Type 33cdf0e10cSrcweir 34cdf0e10cSrcweirPublic Declare Function FindWindow Lib "user32" Alias _ 35cdf0e10cSrcweir "FindWindowA" (ByVal lpClassName As String, _ 36cdf0e10cSrcweir ByVal lpWindowName As Long) As Long 37cdf0e10cSrcweir 38cdf0e10cSrcweirPrivate Declare Function GetTickCount Lib "kernel32" () As Long 39cdf0e10cSrcweir 40cdf0e10cSrcweir'This function saves the passed value to the file, 41cdf0e10cSrcweir'under the section and key names specified. 42cdf0e10cSrcweir'If the ini file, lpFileName, does not exist, it is created. 43cdf0e10cSrcweir'If the section, lpSectionName, does not exist, it is created. 44cdf0e10cSrcweir'If the key name, lpKeyName, does not exist, it is created. 45cdf0e10cSrcweir'If the key name exists, it's value, lpString, is replaced. 46cdf0e10cSrcweirPrivate Declare Function WritePrivateProfileString Lib "kernel32" _ 47cdf0e10cSrcweir Alias "WritePrivateProfileStringA" _ 48cdf0e10cSrcweir (ByVal lpSectionName As String, _ 49cdf0e10cSrcweir ByVal lpKeyName As Any, _ 50cdf0e10cSrcweir ByVal lpString As Any, _ 51cdf0e10cSrcweir ByVal lpFileName As String) As Long 52cdf0e10cSrcweir 53cdf0e10cSrcweirPrivate Declare Function GetPrivateProfileString Lib "kernel32" _ 54cdf0e10cSrcweir Alias "GetPrivateProfileStringA" _ 55cdf0e10cSrcweir (ByVal lpSectionName As String, _ 56cdf0e10cSrcweir ByVal lpKeyName As Any, _ 57cdf0e10cSrcweir ByVal lpDefault As String, _ 58cdf0e10cSrcweir ByVal lpReturnedString As String, _ 59cdf0e10cSrcweir ByVal nSize As Long, _ 60cdf0e10cSrcweir ByVal lpFileName As String) As Long 61cdf0e10cSrcweir 62cdf0e10cSrcweirPrivate Declare Function UrlEscape Lib "shlwapi" _ 63cdf0e10cSrcweir Alias "UrlEscapeA" _ 64cdf0e10cSrcweir (ByVal pszURL As String, _ 65cdf0e10cSrcweir ByVal pszEscaped As String, _ 66cdf0e10cSrcweir pcchEscaped As Long, _ 67cdf0e10cSrcweir ByVal dwFlags As Long) As Long 68cdf0e10cSrcweir 69cdf0e10cSrcweirPublic Declare Function SHGetPathFromIDList Lib "shell32.dll" _ 70cdf0e10cSrcweir (ByVal pidl As Long, ByVal pszPath As String) As Long 71cdf0e10cSrcweir 72cdf0e10cSrcweirPublic Declare Function SHGetSpecialFolderLocation Lib _ 73cdf0e10cSrcweir "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder _ 74cdf0e10cSrcweir As Long, pidl As ITEMIDLIST) As Long 75cdf0e10cSrcweir 76cdf0e10cSrcweirPublic Const LOCALE_ILANGUAGE As Long = &H1 'language id 77cdf0e10cSrcweirPublic Const LOCALE_SLANGUAGE As Long = &H2 'localized name of lang 78cdf0e10cSrcweirPublic Const LOCALE_SENGLANGUAGE As Long = &H1001 'English name of lang 79cdf0e10cSrcweirPublic Const LOCALE_SABBREVLANGNAME As Long = &H3 'abbreviated lang name 80cdf0e10cSrcweirPublic Const LOCALE_SNATIVELANGNAME As Long = &H4 'native name of lang 81cdf0e10cSrcweirPublic Const LOCALE_ICOUNTRY As Long = &H5 'country code 82cdf0e10cSrcweirPublic Const LOCALE_SCOUNTRY As Long = &H6 'localized name of country 83cdf0e10cSrcweirPublic Const LOCALE_SENGCOUNTRY As Long = &H1002 'English name of country 84cdf0e10cSrcweirPublic Const LOCALE_SABBREVCTRYNAME As Long = &H7 'abbreviated country name 85cdf0e10cSrcweirPublic Const LOCALE_SNATIVECTRYNAME As Long = &H8 'native name of country 86cdf0e10cSrcweirPublic Const LOCALE_SINTLSYMBOL As Long = &H15 'intl monetary symbol 87cdf0e10cSrcweirPublic Const LOCALE_IDEFAULTLANGUAGE As Long = &H9 'def language id 88cdf0e10cSrcweirPublic Const LOCALE_IDEFAULTCOUNTRY As Long = &HA 'def country code 89cdf0e10cSrcweirPublic Const LOCALE_IDEFAULTCODEPAGE As Long = &HB 'def oem code page 90cdf0e10cSrcweirPublic Const LOCALE_IDEFAULTANSICODEPAGE As Long = &H1004 'def ansi code page 91cdf0e10cSrcweirPublic Const LOCALE_IDEFAULTMACCODEPAGE As Long = &H1011 'def mac code page 92cdf0e10cSrcweir 93cdf0e10cSrcweirPublic Const LOCALE_IMEASURE As Long = &HD '0 = metric, 1 = US 94cdf0e10cSrcweirPublic Const LOCALE_SSHORTDATE As Long = &H1F 'short date format string 95cdf0e10cSrcweir 96cdf0e10cSrcweir'#if(WINVER >= &H0400) 97cdf0e10cSrcweirPublic Const LOCALE_SISO639LANGNAME As Long = &H59 'ISO abbreviated language name 98cdf0e10cSrcweirPublic Const LOCALE_SISO3166CTRYNAME As Long = &H5A 'ISO abbreviated country name 99cdf0e10cSrcweir'#endif /* WINVER >= as long = &H0400 */ 100cdf0e10cSrcweir 101cdf0e10cSrcweir'#if(WINVER >= &H0500) 102cdf0e10cSrcweirPublic Const LOCALE_SNATIVECURRNAME As Long = &H1008 'native name of currency 103cdf0e10cSrcweirPublic Const LOCALE_IDEFAULTEBCDICCODEPAGE As Long = &H1012 'default ebcdic code page 104cdf0e10cSrcweirPublic Const LOCALE_SSORTNAME As Long = &H1013 'sort name 105cdf0e10cSrcweir'#endif /* WINVER >= &H0500 */ 106cdf0e10cSrcweir 107cdf0e10cSrcweirPublic Declare Function GetSystemDefaultLangID Lib "kernel32" () As Long 108cdf0e10cSrcweirPublic Declare Function GetUserDefaultLangID Lib "kernel32" () As Long 109cdf0e10cSrcweir 110cdf0e10cSrcweirPublic Declare Function GetLocaleInfo Lib "kernel32" _ 111cdf0e10cSrcweir Alias "GetLocaleInfoA" _ 112cdf0e10cSrcweir (ByVal Locale As Long, _ 113cdf0e10cSrcweir ByVal LCType As Long, _ 114cdf0e10cSrcweir ByVal lpLCData As String, _ 115cdf0e10cSrcweir ByVal cchData As Long) As Long 116cdf0e10cSrcweir 117cdf0e10cSrcweir 118cdf0e10cSrcweirPublic Const CWIZARD = "analysis" 119cdf0e10cSrcweir 120cdf0e10cSrcweirConst CROWOFFSET = 2 121cdf0e10cSrcweirConst CDOCPROP_PAW_ROWOFFSET = 3 122cdf0e10cSrcweirPrivate mDocPropRowOffset As Long 123cdf0e10cSrcweir 124cdf0e10cSrcweirConst CNUMBERDOC_ALL = "All" 125cdf0e10cSrcweirConst CTOTAL_DOCS_ANALYZED = "TotalDocsAnalysed" 126cdf0e10cSrcweirConst CNUMDAYS_IN_MONTH = 30 127cdf0e10cSrcweirConst CMAX_LIMIT = 10000 128cdf0e10cSrcweir 129cdf0e10cSrcweirConst CISSUE_DETDOCNAME = 1 130cdf0e10cSrcweirConst CISSUE_DETDOCAPPLICATION = CISSUE_DETDOCNAME + 1 131cdf0e10cSrcweirConst CISSUE_DETTYPE = CISSUE_DETDOCAPPLICATION + 1 132cdf0e10cSrcweirConst CISSUE_DETSUBTYPE = CISSUE_DETTYPE + 1 133cdf0e10cSrcweirConst CISSUE_DETLOCATION = CISSUE_DETSUBTYPE + 1 134cdf0e10cSrcweirConst CISSUE_DETSUBLOCATION = CISSUE_DETLOCATION + 1 135cdf0e10cSrcweirConst CISSUE_DETLINE = CISSUE_DETSUBLOCATION + 1 136cdf0e10cSrcweirConst CISSUE_DETCOLUMN = CISSUE_DETLINE + 1 137cdf0e10cSrcweirConst CISSUE_DETATTRIBUTES = CISSUE_DETCOLUMN + 1 138cdf0e10cSrcweirConst CISSUE_DETNAMEANDPATH = CISSUE_DETATTRIBUTES + 1 139cdf0e10cSrcweir 140cdf0e10cSrcweirConst CREF_DETDOCNAME = 1 141cdf0e10cSrcweirConst CREF_DETDOCAPPLICATION = CREF_DETDOCNAME + 1 142cdf0e10cSrcweirConst CREF_DETREFERENCE = CREF_DETDOCAPPLICATION + 1 143cdf0e10cSrcweirConst CREF_DETDESCRIPTION = CREF_DETREFERENCE + 1 144cdf0e10cSrcweirConst CREF_DETLOCATION = CREF_DETDESCRIPTION + 1 145cdf0e10cSrcweirConst CREF_DETATTRIBUTES = CREF_DETLOCATION + 1 146cdf0e10cSrcweirConst CREF_DETNAMEANDPATH = CREF_DETATTRIBUTES + 1 147cdf0e10cSrcweir 148cdf0e10cSrcweirConst CINPUT_DIR = "indir" 149cdf0e10cSrcweirConst COUTPUT_DIR = "outdir" 150cdf0e10cSrcweirConst CRESULTS_FILE = "resultsfile" 151cdf0e10cSrcweirConst CLOG_FILE = "logfile" 152cdf0e10cSrcweirConst CRESULTS_TEMPLATE = "resultstemplate" 153cdf0e10cSrcweirConst CRESULTS_EXIST = "resultsexist" 154cdf0e10cSrcweirConst COVERWRITE_FILE = "overwritefile" 155cdf0e10cSrcweirConst CNEW_RESULTS_FILE = "newresultsfile" 156cdf0e10cSrcweirConst CINCLUDE_SUBDIRS = "includesubdirs" 157cdf0e10cSrcweirConst CDEBUG_LEVEL = "debuglevel" 158cdf0e10cSrcweirConst COUTPUT_TYPE = "outputtype" 159cdf0e10cSrcweirConst COUTPUT_TYPE_XLS = "xls" 160cdf0e10cSrcweirConst COUTPUT_TYPE_XML = "xml" 161cdf0e10cSrcweirConst COUTPUT_TYPE_BOTH = "both" 162cdf0e10cSrcweirConst COVERVIEW_TITLE_LABEL = "OV_Document_Analysis_Overview_lbl" 163cdf0e10cSrcweirConst CDEFAULT_PASSWORD = "defaultpassword" 164cdf0e10cSrcweirConst CVERSION = "version" 165cdf0e10cSrcweirConst CTITLE = "title" 166cdf0e10cSrcweirConst CDOPREPARE = "prepare" 167cdf0e10cSrcweirConst CISSUES_LIMIT = "issuesmonthlimit" 168cdf0e10cSrcweirConst CSINGLE_FILE = "singlefile" 169cdf0e10cSrcweirConst CFILE_LIST = "filelist" 170cdf0e10cSrcweirConst CSTAT_FILE = "statfilename" 171cdf0e10cSrcweirConst C_ABORT_ANALYSIS = "abortanalysis" 172cdf0e10cSrcweirConst C_DOCS_LESS_3_MONTH = "DocumentsYoungerThan3Month" 173cdf0e10cSrcweirConst C_DOCS_LESS_6_MONTH = "DocumentsYoungerThan6Month" 174cdf0e10cSrcweirConst C_DOCS_LESS_12_MONTH = "DocumentsYoungerThan12Month" 175cdf0e10cSrcweirConst C_DOCS_MORE_12_MONTH = "DocumentsOlderThan12Month" 176cdf0e10cSrcweir 177cdf0e10cSrcweirPrivate Const C_ANALYSIS As String = "Analysis" 178cdf0e10cSrcweirPrivate Const C_LAST_CHECKPOINT As String = "LastCheckpoint" 179cdf0e10cSrcweirPrivate Const C_NEXT_FILE As String = "NextFile" 180cdf0e10cSrcweirPrivate Const C_MAX_CHECK_INI As String = "FilesBeforeSave" 181cdf0e10cSrcweirPrivate Const C_MAX_WAIT_BEFORE_WRITE_INI As String = "SecondsBeforeSave" 182cdf0e10cSrcweirPrivate Const C_MAX_RANGE_PROCESS_TIME_INI As String = "ExcelMaxRangeProcessTime" 183cdf0e10cSrcweirPrivate Const C_ERROR_HANDLING_DOC As String = "_ERROR_HANDLING_DOC_" 184cdf0e10cSrcweirPrivate Const C_MAX_CHECK As Long = 100 185cdf0e10cSrcweirPrivate Const C_MAX_WAIT_BEFORE_WRITE As Long = 300 ' sec 186cdf0e10cSrcweirPrivate Const C_MAX_RANGE_PROCESS_TIME As Integer = 30 'sec 187cdf0e10cSrcweir 188cdf0e10cSrcweirPrivate Const C_STAT_STARTING As Integer = 1 189cdf0e10cSrcweirPrivate Const C_STAT_DONE As Integer = 2 190cdf0e10cSrcweirPrivate Const C_STAT_FINISHED As Integer = 3 191cdf0e10cSrcweir 192cdf0e10cSrcweirPrivate Type DocumentCount 193cdf0e10cSrcweir numDocsAnalyzed As Long 194cdf0e10cSrcweir numDocsAnalyzedWithIssues As Long 195cdf0e10cSrcweir numMinorIssues As Long 196cdf0e10cSrcweir numComplexIssues As Long 197cdf0e10cSrcweir numMacroIssues As Long 198cdf0e10cSrcweir numPreparableIssues As Long 199cdf0e10cSrcweir totalMacroCosts As Long 200cdf0e10cSrcweir totalDocIssuesCosts As Long 201cdf0e10cSrcweir totalPreparableIssuesCosts As Long 202cdf0e10cSrcweirEnd Type 203cdf0e10cSrcweir 204cdf0e10cSrcweirPrivate Type DocModificationDates 205cdf0e10cSrcweir lessThanThreemonths As Long 206cdf0e10cSrcweir threeToSixmonths As Long 207cdf0e10cSrcweir sixToTwelvemonths As Long 208cdf0e10cSrcweir greaterThanOneYear As Long 209cdf0e10cSrcweirEnd Type 210cdf0e10cSrcweir 211cdf0e10cSrcweirPrivate Type DocMacroClassifications 212cdf0e10cSrcweir None As Long 213cdf0e10cSrcweir Simple As Long 214cdf0e10cSrcweir Medium As Long 215cdf0e10cSrcweir complex As Long 216cdf0e10cSrcweirEnd Type 217cdf0e10cSrcweir 218cdf0e10cSrcweirPrivate Type DocIssueClassifications 219cdf0e10cSrcweir None As Long 220cdf0e10cSrcweir Minor As Long 221cdf0e10cSrcweir complex As Long 222cdf0e10cSrcweirEnd Type 223cdf0e10cSrcweir 224cdf0e10cSrcweirConst CCOST_COL_OFFSET = -1 225cdf0e10cSrcweir 226cdf0e10cSrcweirPrivate mLogFilePath As String 227cdf0e10cSrcweirPrivate mDocIndex As String 228cdf0e10cSrcweirPrivate mDebugLevel As Long 229cdf0e10cSrcweirPrivate mIniFilePath As String 230cdf0e10cSrcweirPrivate mUserFormTypesDict As Scripting.Dictionary 231cdf0e10cSrcweirPrivate mIssuesDict As Scripting.Dictionary 232cdf0e10cSrcweirPrivate mMacroDict As Scripting.Dictionary 233cdf0e10cSrcweirPrivate mPreparedIssuesDict As Scripting.Dictionary 234cdf0e10cSrcweirPrivate mIssuesClassificationDict As Scripting.Dictionary 235cdf0e10cSrcweirPrivate mIssuesCostDict As Scripting.Dictionary 236cdf0e10cSrcweirPrivate mIssuesLimit As Date 237cdf0e10cSrcweir 238cdf0e10cSrcweirPublic Const CWORD_DRIVER_FILE = "_OOoDocAnalysisWordDriver.doc" 239cdf0e10cSrcweirPublic Const CEXCEL_DRIVER_FILE = "_OOoDocAnalysisExcelDriver.xls" 240cdf0e10cSrcweirPublic Const CPP_DRIVER_FILE = "_OOoDocAnalysisPPTDriver.ppt" 241cdf0e10cSrcweirPublic Const CWORD_DRIVER_FILE_TEMP = "~$OoDocAnalysisWordDriver.doc" 242cdf0e10cSrcweirPublic Const CEXCEL_DRIVER_FILE_TEMP = "~$OoDocAnalysisExcelDriver.xls" 243cdf0e10cSrcweirPublic Const CPP_DRIVER_FILE_TEMP = "~$OoDocAnalysisPPTDriver.ppt" 244cdf0e10cSrcweir 245cdf0e10cSrcweir'Doc Properties Offsets - used in WriteDocProperties and GetPreparableFilesFromDocProps 246cdf0e10cSrcweirConst CDOCINFONAME = 1 247cdf0e10cSrcweirConst CDOCINFOAPPLICATION = CDOCINFONAME + 1 248cdf0e10cSrcweir 249cdf0e10cSrcweirConst CDOCINFOISSUE_CLASS = CDOCINFOAPPLICATION + 1 250cdf0e10cSrcweirConst CDOCINFOCOMPLEXISSUES = CDOCINFOISSUE_CLASS + 1 251cdf0e10cSrcweirConst CDOCINFOMINORISSUES = CDOCINFOCOMPLEXISSUES + 1 252cdf0e10cSrcweirConst CDOCINFOPREPAREDISSUES = CDOCINFOMINORISSUES + 1 253cdf0e10cSrcweir 254cdf0e10cSrcweirConst CDOCINFOMACRO_CLASS = CDOCINFOPREPAREDISSUES + 1 255cdf0e10cSrcweirConst CDOCINFOMACRO_USERFORMS = CDOCINFOMACRO_CLASS + 1 256cdf0e10cSrcweirConst CDOCINFOMACRO_LINESOFCODE = CDOCINFOMACRO_USERFORMS + 1 257cdf0e10cSrcweir 258cdf0e10cSrcweirConst CDOCINFODOCISSUECOSTS = CDOCINFOMACRO_LINESOFCODE + 1 259cdf0e10cSrcweirConst CDOCINFOPREPARABLEISSUECOSTS = CDOCINFODOCISSUECOSTS + 1 260cdf0e10cSrcweirConst CDOCINFOMACROISSUECOSTS = CDOCINFOPREPARABLEISSUECOSTS + 1 261cdf0e10cSrcweir 262cdf0e10cSrcweirConst CDOCINFONUMBERPAGES = CDOCINFOMACROISSUECOSTS + 1 263cdf0e10cSrcweirConst CDOCINFOCREATED = CDOCINFONUMBERPAGES + 1 264cdf0e10cSrcweirConst CDOCINFOLASTMODIFIED = CDOCINFOCREATED + 1 265cdf0e10cSrcweirConst CDOCINFOLASTACCESSED = CDOCINFOLASTMODIFIED + 1 266cdf0e10cSrcweirConst CDOCINFOLASTPRINTED = CDOCINFOLASTACCESSED + 1 267cdf0e10cSrcweirConst CDOCINFOLASTSAVEDBY = CDOCINFOLASTPRINTED + 1 268cdf0e10cSrcweirConst CDOCINFOREVISION = CDOCINFOLASTSAVEDBY + 1 269cdf0e10cSrcweirConst CDOCINFOTEMPLATE = CDOCINFOREVISION + 1 270cdf0e10cSrcweirConst CDOCINFONAMEANDPATH = CDOCINFOTEMPLATE + 1 271cdf0e10cSrcweir 272cdf0e10cSrcweir'Overview shapes 273cdf0e10cSrcweirConst COV_DOC_MOD_DATES_CHART = "Chart 21" 274cdf0e10cSrcweirConst COV_DOC_MACRO_CHART = "Chart 22" 275cdf0e10cSrcweirConst COV_DOC_ANALYSIS_CHART = "Chart 23" 276cdf0e10cSrcweir 277cdf0e10cSrcweirConst COV_DOC_MOD_DATES_COMMENT_TXB = "Text Box 25" 278cdf0e10cSrcweirConst COV_DOC_MOD_DATES_LEGEND_TXB = "Text Box 12" 279cdf0e10cSrcweir 280cdf0e10cSrcweirConst COV_DOC_MACRO_COMMENT_TXB = "Text Box 26" 281cdf0e10cSrcweirConst COV_DOC_MACRO_LEGEND_TXB = "Text Box 16" 282cdf0e10cSrcweir 283cdf0e10cSrcweirConst COV_DOC_ANALYSIS_COMMENT_TXB = "Text Box 27" 284cdf0e10cSrcweirConst COV_DOC_ANALYSIS_LEGEND_DAW_TXB = "Text Box 28" 285cdf0e10cSrcweirConst COV_DOC_ANALYSIS_LEGEND_PAW_TXB = "Text Box 18" 286cdf0e10cSrcweir 287cdf0e10cSrcweirConst COV_HIGH_LEVEL_ANALYSIS_RANGE = "OV_High_Level_Analysis_Range" 288cdf0e10cSrcweirConst COV_COST_RANGE = "OV_Cost_Range" 289cdf0e10cSrcweir 290cdf0e10cSrcweir'Sheet labels 291cdf0e10cSrcweirConst COV_HIGH_LEVEL_ANALYSIS_LBL = "OV_High_level_analysis_lbl" 292cdf0e10cSrcweirConst COV_DP_PREPISSUES_COL_LBL = "DocProperties_PreparedIssues_Column" 293cdf0e10cSrcweirConst COV_COSTS_PREPISSUE_COUNT_COL_LBL = "Costs_PreparedIssueCount_Column" 294cdf0e10cSrcweirConst CDP_DAW_HIDDEN_COLS_LBL = "DP_DAW_HIDDEN_COLS_RANGE" 295cdf0e10cSrcweirConst CDP_DAW_HIDDEN_COLS2_LBL = "DP_DAW_HIDDEN_COLS_RANGE2" 296cdf0e10cSrcweirConst CDP_DAW_HIDDEN_ROW_LBL = "DP_DAW_HIDDEN_ROW_RANGE" 297cdf0e10cSrcweir 298cdf0e10cSrcweirConst COV_DAW_SETUP_SHEETS_RUN_LBL = "OV_DAW_SETUP_SHEETS_RUN" 299cdf0e10cSrcweirConst COV_PAW_SETUP_SHEETS_RUN_LBL = "OV_PAW_SETUP_SHEETS_RUN" 300cdf0e10cSrcweirConst COV_Internal_Attributes_Cols_LBL = "OV_Internal_Attributes_Cols" 301cdf0e10cSrcweir 302cdf0e10cSrcweirConst CR_STR = "<CR>" 303cdf0e10cSrcweirConst CR_TOPIC = "<TOPIC>" 304cdf0e10cSrcweirConst CR_PRODUCT = "<PRODUCT>" 305cdf0e10cSrcweir 306cdf0e10cSrcweirConst CLEGEND_FONT_SIZE = 8 307cdf0e10cSrcweirConst CCOMMENTS_FONT_SIZE = 10 308cdf0e10cSrcweir 309cdf0e10cSrcweirDim mTstart As Single 310cdf0e10cSrcweirDim mTend As Single 311cdf0e10cSrcweirPublic gExcelMaxRangeProcessTime As Integer 312cdf0e10cSrcweir 313cdf0e10cSrcweirSub AnalyseDirectory() 314cdf0e10cSrcweir On Error GoTo HandleErrors 315cdf0e10cSrcweir Dim currentFunctionName As String 316cdf0e10cSrcweir currentFunctionName = "AnalyseDirectory" 317cdf0e10cSrcweir 318cdf0e10cSrcweir Dim iniFilePath As String 319cdf0e10cSrcweir Dim startDir As String 320cdf0e10cSrcweir Dim fileList As String 321cdf0e10cSrcweir Dim storeToDir As String 322cdf0e10cSrcweir Dim resultsFile As String 323cdf0e10cSrcweir Dim resultsTemplate As String 324cdf0e10cSrcweir Dim statFileName As String 325cdf0e10cSrcweir Dim bOverwriteResultsFile As Boolean 326cdf0e10cSrcweir Dim bNewResultsFile As Boolean 327cdf0e10cSrcweir Dim outputType As String 328cdf0e10cSrcweir Dim singleFile As String 329cdf0e10cSrcweir Dim nTimeNeeded As Long 330cdf0e10cSrcweir Dim nIncrementFileCounter As Long 331cdf0e10cSrcweir Dim nMaxWaitBeforeWrite As Long 332cdf0e10cSrcweir Dim fso As Scripting.FileSystemObject 333cdf0e10cSrcweir Set fso = New Scripting.FileSystemObject 334cdf0e10cSrcweir 335cdf0e10cSrcweir SetAppToMinimized 336cdf0e10cSrcweir 337cdf0e10cSrcweir If InDocPreparation Then 338cdf0e10cSrcweir mDocPropRowOffset = CDOCPROP_PAW_ROWOFFSET 339cdf0e10cSrcweir Else 340cdf0e10cSrcweir mDocPropRowOffset = CROWOFFSET 341cdf0e10cSrcweir End If 342cdf0e10cSrcweir 343cdf0e10cSrcweir 'Get Wizard input variables 344cdf0e10cSrcweir SetupWizardVariables fileList, storeToDir, resultsFile, _ 345cdf0e10cSrcweir mLogFilePath, resultsTemplate, bOverwriteResultsFile, bNewResultsFile, _ 346cdf0e10cSrcweir statFileName, mDebugLevel, outputType, singleFile 347cdf0e10cSrcweir 348cdf0e10cSrcweir startDir = ProfileGetItem("Analysis", CINPUT_DIR, "", mIniFilePath) 349cdf0e10cSrcweir 350cdf0e10cSrcweir nIncrementFileCounter = CLng(ProfileGetItem("Analysis", _ 351cdf0e10cSrcweir C_MAX_CHECK_INI, C_MAX_CHECK, mIniFilePath)) 352cdf0e10cSrcweir nMaxWaitBeforeWrite = CLng(ProfileGetItem("Analysis", _ 353cdf0e10cSrcweir C_MAX_WAIT_BEFORE_WRITE_INI, C_MAX_WAIT_BEFORE_WRITE, mIniFilePath)) 354cdf0e10cSrcweir gExcelMaxRangeProcessTime = CInt(ProfileGetItem("Analysis", _ 355cdf0e10cSrcweir C_MAX_RANGE_PROCESS_TIME_INI, C_MAX_RANGE_PROCESS_TIME, mIniFilePath)) 356cdf0e10cSrcweir LocalizeResources 357cdf0e10cSrcweir 358cdf0e10cSrcweir 'Setup File List 359cdf0e10cSrcweir 'For Prepare - get list from results spreadsheet with docs analysis found as preparable 360cdf0e10cSrcweir 'If no results spreadsheet then just try to prepare all the docs - run over full analysis list 361cdf0e10cSrcweir Dim myFiles As Collection 362cdf0e10cSrcweir Set myFiles = New Collection 363cdf0e10cSrcweir Dim sAnalysisOrPrep As String 364cdf0e10cSrcweir If InDocPreparation And CheckDoPrepare Then 365cdf0e10cSrcweir sAnalysisOrPrep = "Prepared" 366cdf0e10cSrcweir If fso.FileExists(storeToDir & "\" & resultsFile) Then 367cdf0e10cSrcweir If Not GetPrepareFilesToAnalyze(storeToDir & "\" & resultsFile, myFiles, fso) Then 368cdf0e10cSrcweir SetPrepareToNone 369cdf0e10cSrcweir WriteDebug currentFunctionName & ": No files to analyse!" 370cdf0e10cSrcweir GoTo FinalExit 'No files to prepare - exit 371cdf0e10cSrcweir End If 372cdf0e10cSrcweir Else 373cdf0e10cSrcweir If Not GetFilesToAnalyze(fileList, singleFile, myFiles) Then 374cdf0e10cSrcweir SetPrepareToNone 375cdf0e10cSrcweir WriteDebug currentFunctionName & ": No files to analyse! Filelist (" & fileList & ") empty?" 376cdf0e10cSrcweir GoTo FinalExit 'No files to prepare - exit 377cdf0e10cSrcweir End If 378cdf0e10cSrcweir End If 379cdf0e10cSrcweir Else 380cdf0e10cSrcweir sAnalysisOrPrep = "Analyzed" 381cdf0e10cSrcweir If Not GetFilesToAnalyze(fileList, singleFile, myFiles) Then 382cdf0e10cSrcweir WriteDebug currentFunctionName & ": No files to analyse! Filelist (" & fileList & ") empty?" 383cdf0e10cSrcweir GoTo FinalExit 384cdf0e10cSrcweir End If 385cdf0e10cSrcweir End If 386cdf0e10cSrcweir 387cdf0e10cSrcweir Dim index As Long 388cdf0e10cSrcweir Dim numFiles As Long 389cdf0e10cSrcweir Dim nextSave As Long 390cdf0e10cSrcweir Dim startIndex As Long 391cdf0e10cSrcweir Dim bResultsWaiting As Boolean 392cdf0e10cSrcweir Dim AnalysedDocs As Collection 393cdf0e10cSrcweir Dim startDate As Date 394cdf0e10cSrcweir Dim currentDate As Date 395cdf0e10cSrcweir 396cdf0e10cSrcweir Set AnalysedDocs = New Collection 397cdf0e10cSrcweir numFiles = myFiles.count 398cdf0e10cSrcweir bResultsWaiting = False 399cdf0e10cSrcweir 400cdf0e10cSrcweir If (singleFile <> "") Then 401cdf0e10cSrcweir ' No recovery handling for single file analysis and the value in the 402cdf0e10cSrcweir ' ini file should be used for bNewResultsFile 403cdf0e10cSrcweir startIndex = 1 404cdf0e10cSrcweir Else 405cdf0e10cSrcweir bNewResultsFile = bNewResultsFile And GetIndexValues(startIndex, nextSave, myFiles) 406cdf0e10cSrcweir End If 407cdf0e10cSrcweir 408cdf0e10cSrcweir startDate = Now() 409cdf0e10cSrcweir 410cdf0e10cSrcweir ' Analyse all files 411cdf0e10cSrcweir For index = startIndex To numFiles 412cdf0e10cSrcweir Set mIssuesClassificationDict = New Scripting.Dictionary 413cdf0e10cSrcweir mIssuesClassificationDict.CompareMode = TextCompare 414cdf0e10cSrcweir Set mIssuesCostDict = New Scripting.Dictionary 415cdf0e10cSrcweir 'mIssuesCostDict.CompareMode = TextCompare 416cdf0e10cSrcweir 417cdf0e10cSrcweir Set mUserFormTypesDict = New Scripting.Dictionary 418cdf0e10cSrcweir Set mIssuesDict = New Scripting.Dictionary 419cdf0e10cSrcweir Set mMacroDict = New Scripting.Dictionary 420cdf0e10cSrcweir Set mPreparedIssuesDict = New Scripting.Dictionary 421cdf0e10cSrcweir 422cdf0e10cSrcweir 'Write to Application log 423cdf0e10cSrcweir Dim myAnalyser As MigrationAnalyser 424cdf0e10cSrcweir Set myAnalyser = New MigrationAnalyser 425cdf0e10cSrcweir 426cdf0e10cSrcweir If (CheckForAbort) Then GoTo FinalExit 427cdf0e10cSrcweir 428cdf0e10cSrcweir 'Log Analysis 429cdf0e10cSrcweir WriteToStatFile statFileName, C_STAT_STARTING, myFiles.item(index), fso 430cdf0e10cSrcweir WriteToLog "Analyzing", myFiles.item(index) 431cdf0e10cSrcweir WriteToIni C_NEXT_FILE, myFiles.item(index) 432cdf0e10cSrcweir mDocIndex = index 433cdf0e10cSrcweir 434cdf0e10cSrcweir 'Do Analysis 435cdf0e10cSrcweir myAnalyser.DoAnalyse myFiles.item(index), mUserFormTypesDict, startDir, storeToDir, fso 436cdf0e10cSrcweir 437cdf0e10cSrcweir AnalysedDocs.Add myAnalyser.Results 438cdf0e10cSrcweir bResultsWaiting = True 439cdf0e10cSrcweir 440cdf0e10cSrcweir WriteToLog sAnalysisOrPrep, index & "of" & numFiles & _ 441cdf0e10cSrcweir " " & getAppSpecificApplicationName & " Documents" 442cdf0e10cSrcweir WriteToLog "Analyzing", "Done" 443cdf0e10cSrcweir WriteToLog sAnalysisOrPrep & "Doc" & index, myFiles.item(index) 444cdf0e10cSrcweir Set myAnalyser = Nothing 445cdf0e10cSrcweir 446cdf0e10cSrcweir If (CheckForAbort) Then GoTo FinalExit 447cdf0e10cSrcweir 448cdf0e10cSrcweir 'No need to output results spreadsheet, just doing prepare 449cdf0e10cSrcweir If CheckDoPrepare Then GoTo CONTINUE_FOR 450cdf0e10cSrcweir 451cdf0e10cSrcweir nTimeNeeded = val(DateDiff("s", startDate, Now())) 452cdf0e10cSrcweir If ((nTimeNeeded > nMaxWaitBeforeWrite) Or _ 453cdf0e10cSrcweir (index >= nextSave)) Then 454cdf0e10cSrcweir If WriteResults(storeToDir, resultsFile, resultsTemplate, _ 455cdf0e10cSrcweir bOverwriteResultsFile, bNewResultsFile, _ 456cdf0e10cSrcweir outputType, AnalysedDocs, fso) Then 457cdf0e10cSrcweir nextSave = index + C_MAX_CHECK 458cdf0e10cSrcweir bResultsWaiting = False 459cdf0e10cSrcweir Set AnalysedDocs = New Collection 460cdf0e10cSrcweir WriteToIni C_LAST_CHECKPOINT, myFiles.item(index) 461cdf0e10cSrcweir startDate = Now() 462cdf0e10cSrcweir Else 463cdf0e10cSrcweir 'write error 464cdf0e10cSrcweir End If 465cdf0e10cSrcweir End If 466cdf0e10cSrcweir WriteToStatFile statFileName, C_STAT_DONE, myFiles.item(index), fso 467cdf0e10cSrcweirCONTINUE_FOR: 468cdf0e10cSrcweir Next index 469cdf0e10cSrcweir 470cdf0e10cSrcweir If (bResultsWaiting) Then 471cdf0e10cSrcweir If WriteResults(storeToDir, resultsFile, resultsTemplate, _ 472cdf0e10cSrcweir bOverwriteResultsFile, bNewResultsFile, _ 473cdf0e10cSrcweir outputType, AnalysedDocs, fso) Then 474cdf0e10cSrcweir WriteToIni C_LAST_CHECKPOINT, myFiles.item(index - 1) 475cdf0e10cSrcweir Else 476cdf0e10cSrcweir 'write error 477cdf0e10cSrcweir End If 478cdf0e10cSrcweir End If 479cdf0e10cSrcweir WriteToStatFile statFileName, C_STAT_FINISHED, "", fso 480cdf0e10cSrcweir 481cdf0e10cSrcweirFinalExit: 482cdf0e10cSrcweir 483cdf0e10cSrcweir Set fso = Nothing 484cdf0e10cSrcweir Set myFiles = Nothing 485cdf0e10cSrcweir Set mIssuesClassificationDict = Nothing 486cdf0e10cSrcweir Set mIssuesCostDict = Nothing 487cdf0e10cSrcweir Set mUserFormTypesDict = Nothing 488cdf0e10cSrcweir Set mIssuesDict = Nothing 489cdf0e10cSrcweir Set mMacroDict = Nothing 490cdf0e10cSrcweir Set mPreparedIssuesDict = Nothing 491cdf0e10cSrcweir 492cdf0e10cSrcweir Set AnalysedDocs = Nothing 493cdf0e10cSrcweir 494cdf0e10cSrcweir Exit Sub 495cdf0e10cSrcweir 496cdf0e10cSrcweirHandleErrors: 497cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 498cdf0e10cSrcweir Resume FinalExit 499cdf0e10cSrcweirEnd Sub 500cdf0e10cSrcweir 501cdf0e10cSrcweirFunction WriteResults(storeToDir As String, resultsFile As String, resultsTemplate As String, _ 502cdf0e10cSrcweir bOverwriteResultsFile As Boolean, bNewResultsFile As Boolean, _ 503cdf0e10cSrcweir outputType As String, AnalysedDocs As Collection, _ 504cdf0e10cSrcweir fso As FileSystemObject) As Boolean 505cdf0e10cSrcweir 506cdf0e10cSrcweir On Error GoTo HandleErrors 507cdf0e10cSrcweir Dim currentFunctionName As String 508cdf0e10cSrcweir currentFunctionName = "WriteResults" 509cdf0e10cSrcweir 510cdf0e10cSrcweir If InDocPreparation Then 511cdf0e10cSrcweir If outputType = COUTPUT_TYPE_XML Or outputType = COUTPUT_TYPE_BOTH Then 512cdf0e10cSrcweir WriteXMLOutput storeToDir, resultsFile, _ 513cdf0e10cSrcweir bOverwriteResultsFile, bNewResultsFile, AnalysedDocs, fso 514cdf0e10cSrcweir End If 515cdf0e10cSrcweir End If 516cdf0e10cSrcweir 517cdf0e10cSrcweir If outputType = COUTPUT_TYPE_XLS Or outputType = COUTPUT_TYPE_BOTH Then 518cdf0e10cSrcweir WriteXLSOutput storeToDir, resultsFile, fso.GetAbsolutePathName(resultsTemplate), _ 519cdf0e10cSrcweir bOverwriteResultsFile, bNewResultsFile, AnalysedDocs, fso 520cdf0e10cSrcweir End If 521cdf0e10cSrcweir 522cdf0e10cSrcweir WriteResults = True 523cdf0e10cSrcweir bNewResultsFile = False 524cdf0e10cSrcweir 525cdf0e10cSrcweirFinalExit: 526cdf0e10cSrcweir Exit Function 527cdf0e10cSrcweir 528cdf0e10cSrcweirHandleErrors: 529cdf0e10cSrcweir WriteResults = False 530cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 531cdf0e10cSrcweir Resume FinalExit 532cdf0e10cSrcweirEnd Function 533cdf0e10cSrcweir 534cdf0e10cSrcweirFunction GetFilesToAnalyze_old(startDir As String, bIncludeSubdirs As Boolean, _ 535cdf0e10cSrcweir myFiles As Collection) As Boolean 536cdf0e10cSrcweir On Error GoTo HandleErrors 537cdf0e10cSrcweir Dim currentFunctionName As String 538cdf0e10cSrcweir currentFunctionName = "GetFilesToAnalyze" 539cdf0e10cSrcweir Dim fso As New FileSystemObject 540cdf0e10cSrcweir Dim theResultsFile As String 541cdf0e10cSrcweir theResultsFile = ProfileGetItem("Analysis", CINPUT_DIR, "c:\", mIniFilePath) & "\" & ProfileGetItem("Analysis", CRESULTS_FILE, "", mIniFilePath) 542cdf0e10cSrcweir 543cdf0e10cSrcweir GetFilesToAnalyze = False 544cdf0e10cSrcweir 545cdf0e10cSrcweir Dim searchTypes As Collection 546cdf0e10cSrcweir Set searchTypes = New Collection 547cdf0e10cSrcweir SetupSearchTypes searchTypes 548cdf0e10cSrcweir If searchTypes.count = 0 Then 549cdf0e10cSrcweir GoTo FinalExit 550cdf0e10cSrcweir End If 551cdf0e10cSrcweir 552cdf0e10cSrcweir Dim myDocFiles As CollectedFiles 553cdf0e10cSrcweir Set myDocFiles = New CollectedFiles 554cdf0e10cSrcweir With myDocFiles 555cdf0e10cSrcweir .BannedList.Add fso.GetAbsolutePathName(getAppSpecificPath & "\" & CWORD_DRIVER_FILE) 556cdf0e10cSrcweir .BannedList.Add fso.GetAbsolutePathName(getAppSpecificPath & "\" & CEXCEL_DRIVER_FILE) 557cdf0e10cSrcweir .BannedList.Add fso.GetAbsolutePathName(getAppSpecificPath & "\" & CPP_DRIVER_FILE) 558cdf0e10cSrcweir .BannedList.Add fso.GetAbsolutePathName(getAppSpecificPath & "\" & CWORD_DRIVER_FILE_TEMP) 559cdf0e10cSrcweir .BannedList.Add fso.GetAbsolutePathName(getAppSpecificPath & "\" & CEXCEL_DRIVER_FILE_TEMP) 560cdf0e10cSrcweir .BannedList.Add fso.GetAbsolutePathName(getAppSpecificPath & "\" & CPP_DRIVER_FILE_TEMP) 561cdf0e10cSrcweir .BannedList.Add theResultsFile 562cdf0e10cSrcweir End With 563cdf0e10cSrcweir myDocFiles.Search rootDir:=startDir, FileSpecs:=searchTypes, _ 564cdf0e10cSrcweir IncludeSubdirs:=bIncludeSubdirs 565cdf0e10cSrcweir 566cdf0e10cSrcweir If getAppSpecificApplicationName = CAPPNAME_WORD Then 567cdf0e10cSrcweir Set myFiles = myDocFiles.WordFiles 568cdf0e10cSrcweir ElseIf getAppSpecificApplicationName = CAPPNAME_EXCEL Then 569cdf0e10cSrcweir Set myFiles = myDocFiles.ExcelFiles 570cdf0e10cSrcweir ElseIf getAppSpecificApplicationName = CAPPNAME_POWERPOINT Then 571cdf0e10cSrcweir Set myFiles = myDocFiles.PowerPointFiles 572cdf0e10cSrcweir Else 573cdf0e10cSrcweir WriteDebug currentFunctionName & " : invalid application " & getAppSpecificApplicationName 574cdf0e10cSrcweir GoTo FinalExit 575cdf0e10cSrcweir End If 576cdf0e10cSrcweir 577cdf0e10cSrcweir GetFilesToAnalyze = True 578cdf0e10cSrcweir 579cdf0e10cSrcweirFinalExit: 580cdf0e10cSrcweir Set searchTypes = Nothing 581cdf0e10cSrcweir Set myDocFiles = Nothing 582cdf0e10cSrcweir 583cdf0e10cSrcweir Exit Function 584cdf0e10cSrcweir 585cdf0e10cSrcweirHandleErrors: 586cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 587cdf0e10cSrcweir Resume FinalExit 588cdf0e10cSrcweirEnd Function 589cdf0e10cSrcweir 590cdf0e10cSrcweirFunction GetFilesToAnalyze(fileList As String, startFile As String, _ 591cdf0e10cSrcweir myFiles As Collection) As Boolean 592cdf0e10cSrcweir 593cdf0e10cSrcweir On Error GoTo HandleErrors 594cdf0e10cSrcweir Dim currentFunctionName As String 595cdf0e10cSrcweir currentFunctionName = "GetFilesToAnalyze" 596cdf0e10cSrcweir 597cdf0e10cSrcweir Dim fso As New FileSystemObject 598cdf0e10cSrcweir Dim fileContent As TextStream 599cdf0e10cSrcweir Dim fileName As String 600cdf0e10cSrcweir 601cdf0e10cSrcweir GetFilesToAnalyze = False 602cdf0e10cSrcweir 603cdf0e10cSrcweir If (startFile = "") Then 604cdf0e10cSrcweir If (fso.FileExists(fileList)) Then 605cdf0e10cSrcweir Set fileContent = fso.OpenTextFile(fileList, ForReading, False, TristateTrue) 606cdf0e10cSrcweir While (Not fileContent.AtEndOfStream) 607cdf0e10cSrcweir fileName = fileContent.ReadLine 608cdf0e10cSrcweir fileName = Trim(fileName) 609cdf0e10cSrcweir If (fileName <> "") Then 610cdf0e10cSrcweir myFiles.Add (fileName) 611cdf0e10cSrcweir End If 612cdf0e10cSrcweir Wend 613cdf0e10cSrcweir fileContent.Close 614cdf0e10cSrcweir End If 615cdf0e10cSrcweir Else 616cdf0e10cSrcweir myFiles.Add (startFile) 617cdf0e10cSrcweir End If 618cdf0e10cSrcweir 619cdf0e10cSrcweir If (myFiles.count <> 0) Then GetFilesToAnalyze = True 620cdf0e10cSrcweir 621cdf0e10cSrcweirFinalExit: 622cdf0e10cSrcweir Set fileContent = Nothing 623cdf0e10cSrcweir Set fso = Nothing 624cdf0e10cSrcweir Exit Function 625cdf0e10cSrcweir 626cdf0e10cSrcweirHandleErrors: 627cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 628cdf0e10cSrcweir Resume FinalExit 629cdf0e10cSrcweirEnd Function 630cdf0e10cSrcweir 631cdf0e10cSrcweirFunction GetPrepareFilesToAnalyze(resultsFilePath As String, myFiles As Collection, _ 632cdf0e10cSrcweir fso As FileSystemObject) As Boolean 633cdf0e10cSrcweir On Error GoTo HandleErrors 634cdf0e10cSrcweir Dim currentFunctionName As String 635cdf0e10cSrcweir currentFunctionName = "GetPrepareFilesToAnalyze" 636cdf0e10cSrcweir 637cdf0e10cSrcweir GetPrepareFilesToAnalyze = False 638cdf0e10cSrcweir 639cdf0e10cSrcweir If Not fso.FileExists(resultsFilePath) Then 640cdf0e10cSrcweir WriteDebug currentFunctionName & ": results file does not exist : " & resultsFilePath 641cdf0e10cSrcweir GoTo FinalExit 642cdf0e10cSrcweir End If 643cdf0e10cSrcweir 644cdf0e10cSrcweir 'Open results spreadsheet 645cdf0e10cSrcweir Dim xl As Excel.Application 646cdf0e10cSrcweir If getAppSpecificApplicationName = CAPPNAME_EXCEL Then 647cdf0e10cSrcweir Set xl = Application 648cdf0e10cSrcweir xl.Visible = True 649cdf0e10cSrcweir Else 650cdf0e10cSrcweir Set xl = GetExcelInstance 651cdf0e10cSrcweir xl.Visible = False 652cdf0e10cSrcweir End If 653cdf0e10cSrcweir Dim logWb As WorkBook 654cdf0e10cSrcweir Set logWb = xl.Workbooks.Open(resultsFilePath) 655cdf0e10cSrcweir 656cdf0e10cSrcweir Dim wsDocProp As Worksheet 657cdf0e10cSrcweir Set wsDocProp = logWb.Sheets(RID_STR_COMMON_RESULTS_SHEET_NAME_DOCPROP) 658cdf0e10cSrcweir 659cdf0e10cSrcweir Dim startRow As Long 660cdf0e10cSrcweir Dim endRow As Long 661cdf0e10cSrcweir startRow = mDocPropRowOffset + 1 662cdf0e10cSrcweir endRow = GetWorkbookNameValueAsLong(logWb, CTOTAL_DOCS_ANALYZED) + mDocPropRowOffset 663cdf0e10cSrcweir 664cdf0e10cSrcweir GetPreparableFilesFromDocProps wsDocProp, startRow, endRow, fso, myFiles 665cdf0e10cSrcweir 666cdf0e10cSrcweir GetPrepareFilesToAnalyze = (myFiles.count > 0) 667cdf0e10cSrcweir 668cdf0e10cSrcweirFinalExit: 669cdf0e10cSrcweir Set wsDocProp = Nothing 670cdf0e10cSrcweir If Not logWb Is Nothing Then logWb.Close 671cdf0e10cSrcweir Set logWb = Nothing 672cdf0e10cSrcweir 673cdf0e10cSrcweir If getAppSpecificApplicationName <> CAPPNAME_EXCEL Then 674cdf0e10cSrcweir If Not xl Is Nothing Then 675cdf0e10cSrcweir If xl.Workbooks.count = 0 Then 676cdf0e10cSrcweir xl.Quit 677cdf0e10cSrcweir End If 678cdf0e10cSrcweir End If 679cdf0e10cSrcweir End If 680cdf0e10cSrcweir Set xl = Nothing 681cdf0e10cSrcweir 682cdf0e10cSrcweir Exit Function 683cdf0e10cSrcweir 684cdf0e10cSrcweirHandleErrors: 685cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 686cdf0e10cSrcweir Resume FinalExit 687cdf0e10cSrcweirEnd Function 688cdf0e10cSrcweir 689cdf0e10cSrcweirFunction GetPreparableFilesFromDocProps(wsDocProp As Worksheet, startRow As Long, _ 690cdf0e10cSrcweir endRow As Long, fso As FileSystemObject, myFiles As Collection) As Boolean 691cdf0e10cSrcweir On Error GoTo HandleErrors 692cdf0e10cSrcweir Dim currentFunctionName As String 693cdf0e10cSrcweir currentFunctionName = "GetPreparableFilesFromDocProps" 694cdf0e10cSrcweir GetPreparableFilesFromDocProps = False 695cdf0e10cSrcweir 696cdf0e10cSrcweir Dim index As Long 697cdf0e10cSrcweir Dim fileName As String 698cdf0e10cSrcweir Dim fileExt As String 699cdf0e10cSrcweir Dim docExt As String 700cdf0e10cSrcweir Dim templateExt As String 701cdf0e10cSrcweir 702cdf0e10cSrcweir docExt = getAppSpecificDocExt 703cdf0e10cSrcweir templateExt = getAppSpecificTemplateExt 704cdf0e10cSrcweir 705cdf0e10cSrcweir For index = startRow To endRow 706cdf0e10cSrcweir If GetWorksheetCellValueAsLong(wsDocProp, index, CDOCINFOPREPAREDISSUES) > 0 Then 707cdf0e10cSrcweir fileName = GetWorksheetCellValueAsString(wsDocProp, index, CDOCINFONAME) 708cdf0e10cSrcweir fileExt = "." & fso.GetExtensionName(fileName) 709cdf0e10cSrcweir 'Don't have to worry about search types - just looking at existing results 710cdf0e10cSrcweir 'so just check both legal extensions for this application 711cdf0e10cSrcweir If fileExt = docExt Or fileExt = templateExt Then 712cdf0e10cSrcweir myFiles.Add GetWorksheetCellValueAsString(wsDocProp, index, CDOCINFONAMEANDPATH) 713cdf0e10cSrcweir End If 714cdf0e10cSrcweir End If 715cdf0e10cSrcweir Next index 716cdf0e10cSrcweir 717cdf0e10cSrcweir GetPreparableFilesFromDocProps = myFiles.count > 0 718cdf0e10cSrcweirFinalExit: 719cdf0e10cSrcweir Exit Function 720cdf0e10cSrcweir 721cdf0e10cSrcweirHandleErrors: 722cdf0e10cSrcweir GetPreparableFilesFromDocProps = False 723cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 724cdf0e10cSrcweir Resume FinalExit 725cdf0e10cSrcweirEnd Function 726cdf0e10cSrcweir 727cdf0e10cSrcweirSub OpenXLSResultFile(resultsFile As String, _ 728cdf0e10cSrcweir resultsTemplate As String, _ 729cdf0e10cSrcweir bNewResultsFile As Boolean, _ 730cdf0e10cSrcweir excelApp As Excel.Application, _ 731cdf0e10cSrcweir resultSheet As Excel.WorkBook) 732cdf0e10cSrcweir 733cdf0e10cSrcweir On Error GoTo HandleErrors 734cdf0e10cSrcweir Dim currentFunctionName As String 735cdf0e10cSrcweir currentFunctionName = "OpenXLSResultFile" 736cdf0e10cSrcweir 737cdf0e10cSrcweir If getAppSpecificApplicationName = CAPPNAME_EXCEL Then 738cdf0e10cSrcweir Set excelApp = Application 739cdf0e10cSrcweir excelApp.Visible = True 740cdf0e10cSrcweir Else 741cdf0e10cSrcweir Set excelApp = GetExcelInstance 742cdf0e10cSrcweir excelApp.Visible = False 743cdf0e10cSrcweir End If 744cdf0e10cSrcweir 745cdf0e10cSrcweir If bNewResultsFile Then 746cdf0e10cSrcweir Set resultSheet = excelApp.Workbooks.Add(Template:=resultsTemplate) 747cdf0e10cSrcweir Localize_WorkBook resultSheet 748cdf0e10cSrcweir Else 749cdf0e10cSrcweir Set resultSheet = excelApp.Workbooks.Open(resultsFile) 750cdf0e10cSrcweir End If 751cdf0e10cSrcweir 752cdf0e10cSrcweirFinalExit: 753cdf0e10cSrcweir Exit Sub 754cdf0e10cSrcweir 755cdf0e10cSrcweirHandleErrors: 756cdf0e10cSrcweir excelApp.DisplayAlerts = False 757cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 758cdf0e10cSrcweir Resume FinalExit 759cdf0e10cSrcweirEnd Sub 760cdf0e10cSrcweir 761cdf0e10cSrcweirSub CloseXLSResultFile(excelApp As Excel.Application, _ 762cdf0e10cSrcweir resultSheet As Excel.WorkBook) 763cdf0e10cSrcweir 764cdf0e10cSrcweir On Error Resume Next 765cdf0e10cSrcweir 766cdf0e10cSrcweir If Not resultSheet Is Nothing Then resultSheet.Close 767cdf0e10cSrcweir Set resultSheet = Nothing 768cdf0e10cSrcweir 769cdf0e10cSrcweir If getAppSpecificApplicationName <> CAPPNAME_EXCEL Then 770cdf0e10cSrcweir If Not excelApp Is Nothing Then 771cdf0e10cSrcweir excelApp.Visible = True 772cdf0e10cSrcweir If excelApp.Workbooks.count = 0 Then 773cdf0e10cSrcweir excelApp.Quit 774cdf0e10cSrcweir End If 775cdf0e10cSrcweir End If 776cdf0e10cSrcweir End If 777cdf0e10cSrcweir Set excelApp = Nothing 778cdf0e10cSrcweir 779cdf0e10cSrcweir Exit Sub 780cdf0e10cSrcweirEnd Sub 781cdf0e10cSrcweir 782cdf0e10cSrcweirSub WriteXLSOutput(storeToDir As String, resultsFile As String, resultsTemplate As String, _ 783cdf0e10cSrcweir bOverwriteResultsFile As Boolean, bNewResultsFile As Boolean, AnalysedDocs As Collection, _ 784cdf0e10cSrcweir fso As Scripting.FileSystemObject) 785cdf0e10cSrcweir 786cdf0e10cSrcweir On Error GoTo HandleErrors 787cdf0e10cSrcweir Dim currentFunctionName As String 788cdf0e10cSrcweir currentFunctionName = "WriteXLSOutput" 789cdf0e10cSrcweir 790cdf0e10cSrcweir Dim offsetDocPropRow As Long 791cdf0e10cSrcweir Dim offsetDocIssuesRow As Long 792cdf0e10cSrcweir Dim offsetDocIssueDetailsRow As Long 793cdf0e10cSrcweir Dim offsetDocRefDetailsRow As Long 794cdf0e10cSrcweir 795cdf0e10cSrcweir Const COVERVIEW_SHEET_IDX = 1 796cdf0e10cSrcweir Const CDOCLIST_SHEET_IDX = 2 797cdf0e10cSrcweir Const CISSUES_ANALYSED_SHEET = 3 798cdf0e10cSrcweir Const CISSUE_DETAILS_SHEET = 4 799cdf0e10cSrcweir Const CWORD_ISSUES_SHEET = 5 800cdf0e10cSrcweir Const CEXCEL_ISSUES_SHEET = 6 801cdf0e10cSrcweir Const CPOWERPOINT_ISSUES_SHEET = 7 802cdf0e10cSrcweir Const CREFERENCE_ISSUES_SHEET = 8 803cdf0e10cSrcweir 804cdf0e10cSrcweir 'Begin writing stats to excel 805cdf0e10cSrcweir Dim xl As Excel.Application 806cdf0e10cSrcweir If getAppSpecificApplicationName = CAPPNAME_EXCEL Then 807cdf0e10cSrcweir Set xl = Application 808cdf0e10cSrcweir xl.Visible = True 809cdf0e10cSrcweir Else 810cdf0e10cSrcweir Set xl = GetExcelInstance 811cdf0e10cSrcweir xl.Visible = False 812cdf0e10cSrcweir End If 813cdf0e10cSrcweir 814cdf0e10cSrcweir Dim logWb As WorkBook 815cdf0e10cSrcweir 816cdf0e10cSrcweir If bNewResultsFile Then 817cdf0e10cSrcweir Set logWb = xl.Workbooks.Add(Template:=resultsTemplate) 818cdf0e10cSrcweir Localize_WorkBook logWb 819cdf0e10cSrcweir Else 820cdf0e10cSrcweir Set logWb = xl.Workbooks.Open(storeToDir & "\" & resultsFile) 821cdf0e10cSrcweir End If 822cdf0e10cSrcweir 823cdf0e10cSrcweir SetupAnalysisResultsVariables logWb, offsetDocPropRow, _ 824cdf0e10cSrcweir offsetDocIssuesRow, offsetDocIssueDetailsRow, offsetDocRefDetailsRow 825cdf0e10cSrcweir 826cdf0e10cSrcweir ' Iterate through results and write info 827cdf0e10cSrcweir Dim aAnalysis As DocumentAnalysis 828cdf0e10cSrcweir Dim row As Long 829cdf0e10cSrcweir Dim docCounts As DocumentCount 830cdf0e10cSrcweir Dim templateCounts As DocumentCount 831cdf0e10cSrcweir 832cdf0e10cSrcweir Dim issuesRow As Long 833cdf0e10cSrcweir Dim issueDetailsRow As Long 834cdf0e10cSrcweir Dim refDetailsRow As Long 835cdf0e10cSrcweir 836cdf0e10cSrcweir Dim wsOverview As Worksheet 837cdf0e10cSrcweir Dim wsCosts As Worksheet 838cdf0e10cSrcweir Dim wsPgStats As Worksheet 839cdf0e10cSrcweir Dim wsIssues As Worksheet 840cdf0e10cSrcweir Dim wsIssueDetails As Worksheet 841cdf0e10cSrcweir Dim wsRefDetails As Worksheet 842cdf0e10cSrcweir 843cdf0e10cSrcweir Set wsOverview = logWb.Sheets(COVERVIEW_SHEET_IDX) 844cdf0e10cSrcweir Set wsPgStats = logWb.Sheets(CDOCLIST_SHEET_IDX) 845cdf0e10cSrcweir 846cdf0e10cSrcweir 'Some localized names might be longer than 31 chars, excel doesn't 847cdf0e10cSrcweir 'allow such names! 848cdf0e10cSrcweir On Error Resume Next 849cdf0e10cSrcweir wsOverview.name = RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW 850cdf0e10cSrcweir wsPgStats.name = RID_STR_COMMON_RESULTS_SHEET_NAME_DOCPROP 851cdf0e10cSrcweir On Error GoTo HandleErrors 852cdf0e10cSrcweir 853cdf0e10cSrcweir If InDocPreparation Then 854cdf0e10cSrcweir Set wsCosts = logWb.Sheets(CISSUES_ANALYSED_SHEET) 855cdf0e10cSrcweir Dim appName As String 856cdf0e10cSrcweir appName = getAppSpecificApplicationName 857cdf0e10cSrcweir Select Case appName 858cdf0e10cSrcweir Case "Word" 859cdf0e10cSrcweir Set wsIssues = logWb.Worksheets(CWORD_ISSUES_SHEET) 860cdf0e10cSrcweir Case "Excel" 861cdf0e10cSrcweir Set wsIssues = logWb.Worksheets(CEXCEL_ISSUES_SHEET) 862cdf0e10cSrcweir Case "PowerPoint" 863cdf0e10cSrcweir Set wsIssues = logWb.Worksheets(CPOWERPOINT_ISSUES_SHEET) 864cdf0e10cSrcweir Case Default 865cdf0e10cSrcweir Err.Raise Number:=-1, Description:="BadAppName" 866cdf0e10cSrcweir End Select 867cdf0e10cSrcweir Set wsIssueDetails = logWb.Sheets(CISSUE_DETAILS_SHEET) 868cdf0e10cSrcweir Set wsRefDetails = logWb.Sheets(CREFERENCE_ISSUES_SHEET) 869cdf0e10cSrcweir issuesRow = 1 + CROWOFFSET + offsetDocIssuesRow 870cdf0e10cSrcweir issueDetailsRow = 1 + CROWOFFSET + offsetDocIssueDetailsRow 871cdf0e10cSrcweir refDetailsRow = 1 + CROWOFFSET + offsetDocRefDetailsRow 872cdf0e10cSrcweir ' localize PAW worksheets 873cdf0e10cSrcweir Dim wsWordIssues As Worksheet 874cdf0e10cSrcweir Dim wsExcelIssues As Worksheet 875cdf0e10cSrcweir Dim wsPowerPointIssues As Worksheet 876cdf0e10cSrcweir Set wsWordIssues = logWb.Worksheets(CWORD_ISSUES_SHEET) 877cdf0e10cSrcweir Set wsExcelIssues = logWb.Worksheets(CEXCEL_ISSUES_SHEET) 878cdf0e10cSrcweir Set wsPowerPointIssues = logWb.Worksheets(CPOWERPOINT_ISSUES_SHEET) 879cdf0e10cSrcweir 880cdf0e10cSrcweir On Error Resume Next 881cdf0e10cSrcweir wsCosts.name = RID_STR_COMMON_RESULTS_SHEET_NAME_COSTS 882cdf0e10cSrcweir wsIssueDetails.name = RID_STR_COMMON_RESULTS_SHEET_NAME_DOCISSUE_DETAILS 883cdf0e10cSrcweir wsRefDetails.name = RID_STR_COMMON_RESULTS_SHEET_NAME_DOCREF_DETAILS 884cdf0e10cSrcweir wsWordIssues.name = RID_STR_COMMON_RESULTS_SHEET_NAME_DOCISSUES_WORD 885cdf0e10cSrcweir wsExcelIssues.name = RID_STR_COMMON_RESULTS_SHEET_NAME_DOCISSUES_EXCEL 886cdf0e10cSrcweir wsPowerPointIssues.name = RID_STR_COMMON_RESULTS_SHEET_NAME_DOCISSUES_POWERPOINT 887cdf0e10cSrcweir On Error GoTo HandleErrors 888cdf0e10cSrcweir End If 889cdf0e10cSrcweir 890cdf0e10cSrcweir Dim fileName As String 891cdf0e10cSrcweir Dim macroClasses As DocMacroClassifications 892cdf0e10cSrcweir Dim issueClasses As DocIssueClassifications 893cdf0e10cSrcweir 894cdf0e10cSrcweir For row = 1 To AnalysedDocs.count 'Need Row count - so not using Eor Each 895cdf0e10cSrcweir Set aAnalysis = AnalysedDocs.item(row) 896cdf0e10cSrcweir fileName = fso.GetFileName(aAnalysis.name) 897cdf0e10cSrcweir 898cdf0e10cSrcweir If InDocPreparation Then 899cdf0e10cSrcweir issuesRow = WriteDocIssues(wsIssues, issuesRow, aAnalysis, fileName) 900cdf0e10cSrcweir issueDetailsRow = _ 901cdf0e10cSrcweir ProcessIssuesAndWriteDocIssueDetails(logWb, wsIssueDetails, issueDetailsRow, aAnalysis, fileName) 902cdf0e10cSrcweir refDetailsRow = _ 903cdf0e10cSrcweir WriteDocRefDetails(wsRefDetails, refDetailsRow, aAnalysis, fileName) 904cdf0e10cSrcweir aAnalysis.MacroCosts = getMacroIssueCosts(logWb, aAnalysis) 905cdf0e10cSrcweir WriteDocProperties wsPgStats, row + offsetDocPropRow, aAnalysis, fileName 906cdf0e10cSrcweir Else 907cdf0e10cSrcweir ProcessIssuesForDAW logWb, aAnalysis, fileName 908cdf0e10cSrcweir WriteDocProperties wsPgStats, row + offsetDocPropRow, aAnalysis, fileName 909cdf0e10cSrcweir End If 910cdf0e10cSrcweir 911cdf0e10cSrcweir UpdateAllCounts aAnalysis, docCounts, templateCounts, macroClasses, issueClasses, fso 912cdf0e10cSrcweir 913cdf0e10cSrcweir Set aAnalysis = Nothing 914cdf0e10cSrcweir Next row 915cdf0e10cSrcweir 916cdf0e10cSrcweir ' We change the font used for text box shapes here for the japanese 917cdf0e10cSrcweir ' version, because office 2000 sometimes displays squares instead of 918cdf0e10cSrcweir ' chars 919cdf0e10cSrcweir Dim langStr As String 920cdf0e10cSrcweir Dim userLCID As Long 921cdf0e10cSrcweir Dim textSize As Long 922cdf0e10cSrcweir Dim fontName As String 923cdf0e10cSrcweir 924cdf0e10cSrcweir userLCID = GetUserDefaultLangID() 925cdf0e10cSrcweir langStr = GetUserLocaleInfo(userLCID, LOCALE_SISO639LANGNAME) 926cdf0e10cSrcweir 927cdf0e10cSrcweir If (langStr = "ja") Then 928cdf0e10cSrcweir WriteDebug currentFunctionName & " : Setting font to MS PGothic for 'ja' locale" 929cdf0e10cSrcweir fontName = "MS PGothic" 930cdf0e10cSrcweir textSize = 10 931cdf0e10cSrcweir Else 932cdf0e10cSrcweir fontName = "Arial" 933cdf0e10cSrcweir textSize = CLEGEND_FONT_SIZE 934cdf0e10cSrcweir End If 935cdf0e10cSrcweir 936cdf0e10cSrcweir 'DAW - PAW switches 937cdf0e10cSrcweir If InDocPreparation Then 938cdf0e10cSrcweir SaveAnalysisResultsVariables logWb, issueDetailsRow - (1 + CROWOFFSET), _ 939cdf0e10cSrcweir refDetailsRow - (1 + CROWOFFSET) 940cdf0e10cSrcweir 941cdf0e10cSrcweir WriteOverview logWb, docCounts, templateCounts, macroClasses, issueClasses 942cdf0e10cSrcweir 943cdf0e10cSrcweir SetupPAWResultsSpreadsheet logWb, fontName, textSize 944cdf0e10cSrcweir WriteIssueCounts logWb 945cdf0e10cSrcweir Else 946cdf0e10cSrcweir WriteOverview logWb, docCounts, templateCounts, macroClasses, issueClasses 947cdf0e10cSrcweir 948cdf0e10cSrcweir 'StartTiming 949cdf0e10cSrcweir SetupDAWResultsSpreadsheet logWb, fontName, textSize 950cdf0e10cSrcweir 'EndTiming "SetupDAWResultsSpreadsheet" 951cdf0e10cSrcweir End If 952cdf0e10cSrcweir 953cdf0e10cSrcweir SetupPrintRanges logWb, row, issuesRow, issueDetailsRow, refDetailsRow 954cdf0e10cSrcweir 955cdf0e10cSrcweir If resultsFile <> "" Then 956cdf0e10cSrcweir 'Overwrite existing results file without prompting 957cdf0e10cSrcweir If bOverwriteResultsFile Or (Not bNewResultsFile) Then 958cdf0e10cSrcweir xl.DisplayAlerts = False 959cdf0e10cSrcweir End If 960cdf0e10cSrcweir 961cdf0e10cSrcweir logWb.SaveAs fileName:=storeToDir & "\" & resultsFile 962cdf0e10cSrcweir xl.DisplayAlerts = True 963cdf0e10cSrcweir End If 964cdf0e10cSrcweir 965cdf0e10cSrcweirFinalExit: 966cdf0e10cSrcweir If Not xl Is Nothing Then 967cdf0e10cSrcweir xl.Visible = True 968cdf0e10cSrcweir End If 969cdf0e10cSrcweir 970cdf0e10cSrcweir Set wsOverview = Nothing 971cdf0e10cSrcweir Set wsPgStats = Nothing 972cdf0e10cSrcweir 973cdf0e10cSrcweir If InDocPreparation Then 974cdf0e10cSrcweir Set wsCosts = Nothing 975cdf0e10cSrcweir Set wsIssues = Nothing 976cdf0e10cSrcweir Set wsIssueDetails = Nothing 977cdf0e10cSrcweir Set wsRefDetails = Nothing 978cdf0e10cSrcweir End If 979cdf0e10cSrcweir 980cdf0e10cSrcweir If Not logWb Is Nothing Then logWb.Close 981cdf0e10cSrcweir Set logWb = Nothing 982cdf0e10cSrcweir 983cdf0e10cSrcweir If getAppSpecificApplicationName <> CAPPNAME_EXCEL Then 984cdf0e10cSrcweir If Not xl Is Nothing Then 985cdf0e10cSrcweir If xl.Workbooks.count = 0 Then 986cdf0e10cSrcweir xl.Quit 987cdf0e10cSrcweir End If 988cdf0e10cSrcweir End If 989cdf0e10cSrcweir End If 990cdf0e10cSrcweir Set xl = Nothing 991cdf0e10cSrcweir 992cdf0e10cSrcweir Exit Sub 993cdf0e10cSrcweir 994cdf0e10cSrcweirHandleErrors: 995cdf0e10cSrcweir xl.DisplayAlerts = False 996cdf0e10cSrcweir 997cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 998cdf0e10cSrcweir Resume FinalExit 999cdf0e10cSrcweirEnd Sub 1000cdf0e10cSrcweir 1001cdf0e10cSrcweirPublic Sub StartTiming() 1002cdf0e10cSrcweir mTstart = 0 1003cdf0e10cSrcweir mTend = 0 1004cdf0e10cSrcweir mTstart = GetTickCount() 1005cdf0e10cSrcweirEnd Sub 1006cdf0e10cSrcweirPublic Sub EndTiming(what As String) 1007cdf0e10cSrcweir mTend = GetTickCount() 1008cdf0e10cSrcweir WriteDebug "Timing: " & what & ": " & (FormatNumber((mTend - mTstart) / 1000, 0) & " seconds") 1009cdf0e10cSrcweir mTstart = 0 1010cdf0e10cSrcweir mTend = 0 1011cdf0e10cSrcweirEnd Sub 1012cdf0e10cSrcweirSub WriteIssueCounts(logWb As WorkBook) 1013cdf0e10cSrcweir On Error GoTo HandleErrors 1014cdf0e10cSrcweir Dim currentFunctionName As String 1015cdf0e10cSrcweir currentFunctionName = "WriteIssueCounts" 1016cdf0e10cSrcweir 1017cdf0e10cSrcweir Dim Str As String 1018cdf0e10cSrcweir Dim str1 As String 1019cdf0e10cSrcweir Dim val1 As Long 1020cdf0e10cSrcweir Dim count As Long 1021cdf0e10cSrcweir Dim vKeyArray As Variant 1022cdf0e10cSrcweir Dim vItemArray As Variant 1023cdf0e10cSrcweir Dim vPrepKeyArray As Variant 1024cdf0e10cSrcweir Dim vPrepItemArray As Variant 1025cdf0e10cSrcweir 1026cdf0e10cSrcweir vKeyArray = mIssuesDict.Keys 1027cdf0e10cSrcweir vItemArray = mIssuesDict.Items 1028cdf0e10cSrcweir 1029cdf0e10cSrcweir vPrepKeyArray = mPreparedIssuesDict.Keys 1030cdf0e10cSrcweir vPrepItemArray = mPreparedIssuesDict.Items 1031cdf0e10cSrcweir 1032cdf0e10cSrcweir 'Write Issue Counts across all Documents 1033cdf0e10cSrcweir For count = 0 To mIssuesDict.count - 1 1034cdf0e10cSrcweir str1 = vKeyArray(count) 1035cdf0e10cSrcweir val1 = CInt(vItemArray(count)) 1036cdf0e10cSrcweir logWb.Names(str1).RefersToRange.Cells(1, 1) = _ 1037cdf0e10cSrcweir logWb.Names(str1).RefersToRange.Cells(1, 1).value + vItemArray(count) 1038cdf0e10cSrcweir 'DEBUG: str = str & "Key: " & str1 & " Value: " & val1 & vbLf 1039cdf0e10cSrcweir Next count 1040cdf0e10cSrcweir 1041cdf0e10cSrcweir 'Write Prepared Issues Counts across all Documents 1042cdf0e10cSrcweir For count = 0 To mPreparedIssuesDict.count - 1 1043cdf0e10cSrcweir str1 = vPrepKeyArray(count) 1044cdf0e10cSrcweir val1 = CInt(vPrepItemArray(count)) 1045cdf0e10cSrcweir AddVariantToWorkbookNameValue logWb, str1, vPrepItemArray(count) 1046cdf0e10cSrcweir 'DEBUG: str = str & "Key: " & str1 & " Value: " & val1 & vbLf 1047cdf0e10cSrcweir Next count 1048cdf0e10cSrcweir 1049cdf0e10cSrcweir 'User Form control type count across all analyzed documents of this type 1050cdf0e10cSrcweir str1 = getAppSpecificApplicationName & "_" & _ 1051cdf0e10cSrcweir CSTR_ISSUE_VBA_MACROS & "_" & _ 1052cdf0e10cSrcweir CSTR_SUBISSUE_PROPERTIES & "_" & _ 1053cdf0e10cSrcweir CSTR_SUBISSUE_VBA_MACROS_USERFORMS_CONTROLTYPE_COUNT 1054cdf0e10cSrcweir SetWorkbookNameValueToLong logWb, str1, mUserFormTypesDict.count 1055cdf0e10cSrcweir 1056cdf0e10cSrcweir 'Add list of User Form controls and counts to ...USERFORMS_CONTROLTYPE_COUNT field 1057cdf0e10cSrcweir If mUserFormTypesDict.count > 0 Then 1058cdf0e10cSrcweir vKeyArray = mUserFormTypesDict.Keys 1059cdf0e10cSrcweir vItemArray = mUserFormTypesDict.Items 1060cdf0e10cSrcweir 1061cdf0e10cSrcweir Str = RID_STR_COMMON_ATTRIBUTE_CONTROLS & ": " 1062cdf0e10cSrcweir For count = 0 To mUserFormTypesDict.count - 1 1063cdf0e10cSrcweir Str = Str & vbLf & vKeyArray(count) & " " & vItemArray(count) 1064cdf0e10cSrcweir Next count 1065cdf0e10cSrcweir WriteUserFromControlTypesComment logWb, str1, Str 1066cdf0e10cSrcweir End If 1067cdf0e10cSrcweir 'DEBUG: MsgBox str & vbLf & mIssuesDict.count 1068cdf0e10cSrcweir 1069cdf0e10cSrcweir WriteUniqueModuleCount logWb 1070cdf0e10cSrcweir 1071cdf0e10cSrcweirFinalExit: 1072cdf0e10cSrcweir Exit Sub 1073cdf0e10cSrcweir 1074cdf0e10cSrcweirHandleErrors: 1075cdf0e10cSrcweir WriteDebug currentFunctionName & _ 1076cdf0e10cSrcweir " : logging costs : " & _ 1077cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 1078cdf0e10cSrcweir Resume FinalExit 1079cdf0e10cSrcweirEnd Sub 1080cdf0e10cSrcweirSub WriteUniqueModuleCount(logWb As WorkBook) 1081cdf0e10cSrcweir On Error GoTo HandleErrors 1082cdf0e10cSrcweir Dim currentFunctionName As String 1083cdf0e10cSrcweir currentFunctionName = "WriteUniqueModuleCount" 1084cdf0e10cSrcweir 1085cdf0e10cSrcweir Dim strLabel As String 1086cdf0e10cSrcweir Dim uniqueLineCount As Long 1087cdf0e10cSrcweir Dim uniqueModuleCount As Long 1088cdf0e10cSrcweir Dim count As Long 1089cdf0e10cSrcweir Dim vItemArray As Variant 1090cdf0e10cSrcweir 1091cdf0e10cSrcweir vItemArray = mMacroDict.Items 1092cdf0e10cSrcweir 1093cdf0e10cSrcweir 'Write Issues Costs 1094cdf0e10cSrcweir uniqueLineCount = 0 1095cdf0e10cSrcweir For count = 0 To mMacroDict.count - 1 1096cdf0e10cSrcweir uniqueLineCount = uniqueLineCount + CInt(vItemArray(count)) 1097cdf0e10cSrcweir Next count 1098cdf0e10cSrcweir uniqueModuleCount = mMacroDict.count 1099cdf0e10cSrcweir 1100cdf0e10cSrcweir 1101cdf0e10cSrcweir strLabel = getAppSpecificApplicationName & "_" & _ 1102cdf0e10cSrcweir CSTR_ISSUE_VBA_MACROS & "_" & _ 1103cdf0e10cSrcweir CSTR_SUBISSUE_PROPERTIES & "_" & _ 1104cdf0e10cSrcweir CSTR_SUBISSUE_VBA_MACROS_UNIQUE_MODULE_COUNT 1105cdf0e10cSrcweir SetWorkbookNameValueToLong logWb, strLabel, uniqueModuleCount 1106cdf0e10cSrcweir 1107cdf0e10cSrcweir strLabel = getAppSpecificApplicationName & "_" & _ 1108cdf0e10cSrcweir CSTR_ISSUE_VBA_MACROS & "_" & _ 1109cdf0e10cSrcweir CSTR_SUBISSUE_PROPERTIES & "_" & _ 1110cdf0e10cSrcweir CSTR_SUBISSUE_VBA_MACROS_UNIQUE_LINE_COUNT 1111cdf0e10cSrcweir SetWorkbookNameValueToLong logWb, strLabel, uniqueLineCount 1112cdf0e10cSrcweir 1113cdf0e10cSrcweirFinalExit: 1114cdf0e10cSrcweir Exit Sub 1115cdf0e10cSrcweir 1116cdf0e10cSrcweirHandleErrors: 1117cdf0e10cSrcweir WriteDebug currentFunctionName & _ 1118cdf0e10cSrcweir " : logging Unique Module/ Line Counts : " & _ 1119cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 1120cdf0e10cSrcweir Resume FinalExit 1121cdf0e10cSrcweirEnd Sub 1122cdf0e10cSrcweir 1123cdf0e10cSrcweirSub WriteUserFromControlTypesComment(logWb As WorkBook, name As String, comment As String) 1124cdf0e10cSrcweir On Error GoTo HandleErrors 1125cdf0e10cSrcweir Dim currentFunctionName As String 1126cdf0e10cSrcweir currentFunctionName = "WriteUserFromControlTypesComment" 1127cdf0e10cSrcweir 1128cdf0e10cSrcweir On Error Resume Next 'Ignore error if trying to add comment again - would happen on append to results 1129cdf0e10cSrcweir logWb.Names(name).RefersToRange.Cells(1, 1).AddComment 1130cdf0e10cSrcweir 1131cdf0e10cSrcweir On Error GoTo HandleErrors 1132cdf0e10cSrcweir logWb.Names(name).RefersToRange.Cells(1, 1).comment.Text Text:=comment 1133cdf0e10cSrcweir 'Autosize not supported - Office 2000 1134cdf0e10cSrcweir 'logWb.Names(name).RefersToRange.Cells(1, 1).comment.AutoSize = True 1135cdf0e10cSrcweir logWb.Names(name).RefersToRange.Cells(1, 1).comment.Visible = False 1136cdf0e10cSrcweir 1137cdf0e10cSrcweirFinalExit: 1138cdf0e10cSrcweir Exit Sub 1139cdf0e10cSrcweir 1140cdf0e10cSrcweirHandleErrors: 1141cdf0e10cSrcweir WriteDebug currentFunctionName & _ 1142cdf0e10cSrcweir " : name : " & name & _ 1143cdf0e10cSrcweir " : comment : " & comment & _ 1144cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 1145cdf0e10cSrcweir Resume FinalExit 1146cdf0e10cSrcweirEnd Sub 1147cdf0e10cSrcweir 1148cdf0e10cSrcweirSub UpdateAllCounts(aAnalysis As DocumentAnalysis, counts As DocumentCount, templateCounts As DocumentCount, _ 1149cdf0e10cSrcweir macroClasses As DocMacroClassifications, issueClasses As DocIssueClassifications, _ 1150cdf0e10cSrcweir fso As FileSystemObject) 1151cdf0e10cSrcweir Const CMODDATE_LESS3MONTHS = 91 1152cdf0e10cSrcweir Const CMODDATE_LESS6MONTHS = 182 1153cdf0e10cSrcweir Const CMODDATE_LESS12MONTHS = 365 1154cdf0e10cSrcweir 1155cdf0e10cSrcweir On Error GoTo HandleErrors 1156cdf0e10cSrcweir Dim currentFunctionName As String 1157cdf0e10cSrcweir currentFunctionName = "UpdateAllCounts" 1158cdf0e10cSrcweir 'DocIssue Classification occurs in setDocOverallIssueClassification under 1159cdf0e10cSrcweir ' ProcessIssuesAndWriteDocIssueDetails when all DocIssues are being traversed. 1160cdf0e10cSrcweir 'MacroClass for the Doc is setup at the end of the Analyze_Macros in DoAnalysis 1161cdf0e10cSrcweir 'Mod Dates are determined in SetDocProperties in DoAnalysis 1162cdf0e10cSrcweir 1163cdf0e10cSrcweir 'DocMacroClassifications 1164cdf0e10cSrcweir Select Case aAnalysis.MacroOverallClass 1165cdf0e10cSrcweir Case enMacroComplex 1166cdf0e10cSrcweir macroClasses.complex = macroClasses.complex + 1 1167cdf0e10cSrcweir Case enMacroMedium 1168cdf0e10cSrcweir macroClasses.Medium = macroClasses.Medium + 1 1169cdf0e10cSrcweir Case enMacroSimple 1170cdf0e10cSrcweir macroClasses.Simple = macroClasses.Simple + 1 1171cdf0e10cSrcweir Case Else 1172cdf0e10cSrcweir macroClasses.None = macroClasses.None + 1 1173cdf0e10cSrcweir End Select 1174cdf0e10cSrcweir 1175cdf0e10cSrcweir 'DocIssueClassifications 1176cdf0e10cSrcweir aAnalysis.BelowIssuesLimit = True 1177cdf0e10cSrcweir Select Case aAnalysis.DocOverallIssueClass 1178cdf0e10cSrcweir Case enComplex 1179cdf0e10cSrcweir issueClasses.complex = issueClasses.complex + 1 1180cdf0e10cSrcweir Case enMinor 1181cdf0e10cSrcweir issueClasses.Minor = issueClasses.Minor + 1 1182cdf0e10cSrcweir Case Else 1183cdf0e10cSrcweir issueClasses.None = issueClasses.None + 1 1184cdf0e10cSrcweir End Select 1185cdf0e10cSrcweir 1186cdf0e10cSrcweir 'DocumentCounts 1187cdf0e10cSrcweir Dim extStr As String 1188cdf0e10cSrcweir extStr = "." & LCase(fso.GetExtensionName(aAnalysis.name)) 1189cdf0e10cSrcweir If extStr = getAppSpecificDocExt Then 1190cdf0e10cSrcweir UpdateDocCounts counts, aAnalysis 1191cdf0e10cSrcweir ElseIf extStr = getAppSpecificTemplateExt Then 1192cdf0e10cSrcweir UpdateDocCounts templateCounts, aAnalysis 1193cdf0e10cSrcweir Else 1194cdf0e10cSrcweir WriteDebug currentFunctionName & " : path " & aAnalysis.name & _ 1195cdf0e10cSrcweir ": unhandled file extesnion " & extStr & " : " & Err.Number & " " & Err.Description & " " & Err.Source 1196cdf0e10cSrcweir End If 1197cdf0e10cSrcweir 1198cdf0e10cSrcweirFinalExit: 1199cdf0e10cSrcweir Exit Sub 1200cdf0e10cSrcweir 1201cdf0e10cSrcweirHandleErrors: 1202cdf0e10cSrcweir WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1203cdf0e10cSrcweir Resume FinalExit 1204cdf0e10cSrcweirEnd Sub 1205cdf0e10cSrcweirSub UpdateDocCounts(counts As DocumentCount, aAnalysis As DocumentAnalysis) 1206cdf0e10cSrcweir On Error GoTo HandleErrors 1207cdf0e10cSrcweir Dim currentFunctionName As String 1208cdf0e10cSrcweir currentFunctionName = "UpdateDocCounts" 1209cdf0e10cSrcweir 1210cdf0e10cSrcweir counts.numDocsAnalyzed = counts.numDocsAnalyzed + 1 1211cdf0e10cSrcweir If aAnalysis.IssuesCount > 0 Then 'During Analysis incremented 1212cdf0e10cSrcweir counts.numDocsAnalyzedWithIssues = counts.numDocsAnalyzedWithIssues + 1 1213cdf0e10cSrcweir 1214cdf0e10cSrcweir If aAnalysis.BelowIssuesLimit Then 1215cdf0e10cSrcweir counts.numMinorIssues = _ 1216cdf0e10cSrcweir counts.numMinorIssues + aAnalysis.MinorIssuesCount 1217cdf0e10cSrcweir 'MinorIssuesCount incemented as all DocIssues are being traversed are being written out - ProcessIssuesAndWriteDocIssueDetails 1218cdf0e10cSrcweir counts.numComplexIssues = counts.numComplexIssues + aAnalysis.ComplexIssuesCount 'Calculated 1219cdf0e10cSrcweir counts.totalDocIssuesCosts = counts.totalDocIssuesCosts + _ 1220cdf0e10cSrcweir aAnalysis.DocIssuesCosts 1221cdf0e10cSrcweir counts.totalPreparableIssuesCosts = counts.totalPreparableIssuesCosts + _ 1222cdf0e10cSrcweir aAnalysis.PreparableIssuesCosts 1223cdf0e10cSrcweir End If 1224cdf0e10cSrcweir 1225cdf0e10cSrcweir counts.numMacroIssues = counts.numMacroIssues + aAnalysis.MacroIssuesCount 'During Analysis incremented 1226cdf0e10cSrcweir counts.totalMacroCosts = counts.totalMacroCosts + aAnalysis.MacroCosts 1227cdf0e10cSrcweir End If 1228cdf0e10cSrcweir 1229cdf0e10cSrcweirFinalExit: 1230cdf0e10cSrcweir Exit Sub 1231cdf0e10cSrcweir 1232cdf0e10cSrcweirHandleErrors: 1233cdf0e10cSrcweir WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1234cdf0e10cSrcweir Resume FinalExit 1235cdf0e10cSrcweirEnd Sub 1236cdf0e10cSrcweir 1237cdf0e10cSrcweir 1238cdf0e10cSrcweirSub WriteDocProperties(wsPgStats As Worksheet, row As Long, aAnalysis As DocumentAnalysis, _ 1239cdf0e10cSrcweir fileName As String) 1240cdf0e10cSrcweir On Error GoTo HandleErrors 1241cdf0e10cSrcweir Dim currentFunctionName As String 1242cdf0e10cSrcweir currentFunctionName = "WriteDocProperties" 1243cdf0e10cSrcweir 1244cdf0e10cSrcweir Dim rowIndex As Long 1245cdf0e10cSrcweir rowIndex = row + mDocPropRowOffset 1246cdf0e10cSrcweir 1247cdf0e10cSrcweir If aAnalysis.Application = RID_STR_COMMON_CANNOT_OPEN Then 1248cdf0e10cSrcweir SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFONAME, fileName 1249cdf0e10cSrcweir SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOAPPLICATION, aAnalysis.Application 1250cdf0e10cSrcweir SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFONAMEANDPATH, aAnalysis.name 1251cdf0e10cSrcweir 1252cdf0e10cSrcweir GoTo FinalExit 1253cdf0e10cSrcweir End If 1254cdf0e10cSrcweir 1255cdf0e10cSrcweir If InDocPreparation Then 1256cdf0e10cSrcweir SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFONAME, fileName 1257cdf0e10cSrcweir SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOAPPLICATION, aAnalysis.Application 1258cdf0e10cSrcweir 1259cdf0e10cSrcweir SetWorksheetCellValueToLong wsPgStats, rowIndex, CDOCINFODOCISSUECOSTS, aAnalysis.DocIssuesCosts 1260cdf0e10cSrcweir SetWorksheetCellValueToLong wsPgStats, rowIndex, CDOCINFOPREPARABLEISSUECOSTS, aAnalysis.PreparableIssuesCosts 1261cdf0e10cSrcweir SetWorksheetCellValueToLong wsPgStats, rowIndex, CDOCINFOMACROISSUECOSTS, aAnalysis.MacroCosts 1262cdf0e10cSrcweir 1263cdf0e10cSrcweir SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOISSUE_CLASS, _ 1264cdf0e10cSrcweir getDocOverallIssueClassificationAsString(aAnalysis.DocOverallIssueClass) 1265cdf0e10cSrcweir SetWorksheetCellValueToLong wsPgStats, rowIndex, CDOCINFOCOMPLEXISSUES, aAnalysis.ComplexIssuesCount 1266cdf0e10cSrcweir SetWorksheetCellValueToLong wsPgStats, rowIndex, CDOCINFOMINORISSUES, aAnalysis.MinorIssuesCount 1267cdf0e10cSrcweir SetWorksheetCellValueToLong wsPgStats, rowIndex, CDOCINFOPREPAREDISSUES, aAnalysis.PreparableIssuesCount 1268cdf0e10cSrcweir 1269cdf0e10cSrcweir SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOMACRO_CLASS, _ 1270cdf0e10cSrcweir getDocOverallMacroClassAsString(aAnalysis.MacroOverallClass) 1271cdf0e10cSrcweir SetWorksheetCellValueToLong wsPgStats, rowIndex, CDOCINFOMACRO_USERFORMS, aAnalysis.MacroNumUserForms 1272cdf0e10cSrcweir SetWorksheetCellValueToLong wsPgStats, rowIndex, CDOCINFOMACRO_LINESOFCODE, aAnalysis.MacroTotalNumLines 1273cdf0e10cSrcweir 1274cdf0e10cSrcweir SetWorksheetCellValueToLong wsPgStats, rowIndex, CDOCINFONUMBERPAGES, aAnalysis.PageCount 1275cdf0e10cSrcweir SetWorksheetCellValueToVariant wsPgStats, rowIndex, CDOCINFOCREATED, CheckDate(aAnalysis.Created) 1276cdf0e10cSrcweir SetWorksheetCellValueToVariant wsPgStats, rowIndex, CDOCINFOLASTMODIFIED, CheckDate(aAnalysis.Modified) 1277cdf0e10cSrcweir SetWorksheetCellValueToVariant wsPgStats, rowIndex, CDOCINFOLASTACCESSED, CheckDate(aAnalysis.Accessed) 1278cdf0e10cSrcweir SetWorksheetCellValueToVariant wsPgStats, rowIndex, CDOCINFOLASTPRINTED, CheckDate(aAnalysis.Printed) 1279cdf0e10cSrcweir 1280cdf0e10cSrcweir SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOLASTSAVEDBY, aAnalysis.SavedBy 1281cdf0e10cSrcweir SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOREVISION, aAnalysis.Revision 1282cdf0e10cSrcweir SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOTEMPLATE, aAnalysis.Template 1283cdf0e10cSrcweir SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFONAMEANDPATH, aAnalysis.name 1284cdf0e10cSrcweir Else 1285cdf0e10cSrcweir SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFONAME, fileName 1286cdf0e10cSrcweir SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOAPPLICATION, aAnalysis.Application 1287cdf0e10cSrcweir SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOISSUE_CLASS, _ 1288cdf0e10cSrcweir getDocOverallIssueClassificationAsString(aAnalysis.DocOverallIssueClass) 1289cdf0e10cSrcweir SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFOMACRO_CLASS, _ 1290cdf0e10cSrcweir getDocOverallMacroClassAsString(aAnalysis.MacroOverallClass) 1291cdf0e10cSrcweir SetWorksheetCellValueToVariant wsPgStats, rowIndex, CDOCINFOLASTMODIFIED, CheckDate(aAnalysis.Modified) 1292cdf0e10cSrcweir SetWorksheetCellValueToString wsPgStats, rowIndex, CDOCINFONAMEANDPATH, aAnalysis.name 1293cdf0e10cSrcweir End If 1294cdf0e10cSrcweir 1295cdf0e10cSrcweirFinalExit: 1296cdf0e10cSrcweir Exit Sub 1297cdf0e10cSrcweir 1298cdf0e10cSrcweirHandleErrors: 1299cdf0e10cSrcweir WriteDebug currentFunctionName & " : path " & aAnalysis.name & " : " & Err.Number & " " & Err.Description & " " & Err.Source 1300cdf0e10cSrcweir Resume FinalExit 1301cdf0e10cSrcweirEnd Sub 1302cdf0e10cSrcweirFunction CheckDate(myDate As Date) As Variant 1303cdf0e10cSrcweir On Error GoTo HandleErrors 1304cdf0e10cSrcweir Dim currentFunctionName As String 1305cdf0e10cSrcweir currentFunctionName = "CheckDate" 1306cdf0e10cSrcweir 1307cdf0e10cSrcweir Dim lowerNTDateLimit As Date 1308cdf0e10cSrcweir If Not IsDate(myDate) Then 1309cdf0e10cSrcweir CheckDate = RID_STR_COMMON_NA 1310cdf0e10cSrcweir Exit Function 1311cdf0e10cSrcweir End If 1312cdf0e10cSrcweir 1313cdf0e10cSrcweir lowerNTDateLimit = DateSerial(1980, 1, 1) 1314cdf0e10cSrcweir CheckDate = IIf(myDate < lowerNTDateLimit, RID_STR_COMMON_NA, myDate) 1315cdf0e10cSrcweirFinalExit: 1316cdf0e10cSrcweir Exit Function 1317cdf0e10cSrcweir 1318cdf0e10cSrcweirHandleErrors: 1319cdf0e10cSrcweir WriteDebug currentFunctionName & " : date " & myDate & " : " & Err.Number & " " & Err.Description & " " & Err.Source 1320cdf0e10cSrcweir Resume FinalExit 1321cdf0e10cSrcweirEnd Function 1322cdf0e10cSrcweir 1323cdf0e10cSrcweirFunction WriteDocIssues(wsIssues As Worksheet, row As Long, _ 1324cdf0e10cSrcweir aAnalysis As DocumentAnalysis, fileName As String) As Long 1325cdf0e10cSrcweir On Error GoTo HandleErrors 1326cdf0e10cSrcweir Dim currentFunctionName As String 1327cdf0e10cSrcweir currentFunctionName = "WriteDocIssues" 1328cdf0e10cSrcweir 1329cdf0e10cSrcweir Const CNAME = 1 1330cdf0e10cSrcweir Const CAPPLICATION = CNAME + 1 1331cdf0e10cSrcweir Const CISSUE_COLUMNOFFSET = CAPPLICATION 1332cdf0e10cSrcweir 1333cdf0e10cSrcweir If aAnalysis.IssuesCount = 0 Then 1334cdf0e10cSrcweir WriteDocIssues = row 1335cdf0e10cSrcweir Exit Function 1336cdf0e10cSrcweir End If 1337cdf0e10cSrcweir SetWorksheetCellValueToString wsIssues, row, CNAME, fileName 1338cdf0e10cSrcweir SetWorksheetCellValueToString wsIssues, row, CAPPLICATION, aAnalysis.Application 1339cdf0e10cSrcweir 1340cdf0e10cSrcweir Dim index As Integer 1341cdf0e10cSrcweir For index = 1 To aAnalysis.TotalIssueTypes 1342cdf0e10cSrcweir If aAnalysis.IssuesCountArray(index) > 0 Then 1343cdf0e10cSrcweir SetWorksheetCellValueToString wsIssues, row, CISSUE_COLUMNOFFSET + index, aAnalysis.IssuesCountArray(index) 1344cdf0e10cSrcweir End If 1345cdf0e10cSrcweir Next index 1346cdf0e10cSrcweir SetWorksheetCellValueToString wsIssues, row, CISSUE_COLUMNOFFSET + aAnalysis.TotalIssueTypes + 1, aAnalysis.name 1347cdf0e10cSrcweir 1348cdf0e10cSrcweir WriteDocIssues = row + 1 1349cdf0e10cSrcweirFinalExit: 1350cdf0e10cSrcweir Exit Function 1351cdf0e10cSrcweir 1352cdf0e10cSrcweirHandleErrors: 1353cdf0e10cSrcweir WriteDebug currentFunctionName & " : path " & aAnalysis.name & " : " & Err.Number & " " & Err.Description & " " & Err.Source 1354cdf0e10cSrcweir Resume FinalExit 1355cdf0e10cSrcweirEnd Function 1356cdf0e10cSrcweirSub ProcessIssuesForDAW(logWb As WorkBook, aAnalysis As DocumentAnalysis, fileName As String) 1357cdf0e10cSrcweir On Error GoTo HandleErrors 1358cdf0e10cSrcweir Dim currentFunctionName As String 1359cdf0e10cSrcweir currentFunctionName = "ProcessIssuesForDAW" 1360cdf0e10cSrcweir 1361cdf0e10cSrcweir Dim myIssue As IssueInfo 1362cdf0e10cSrcweir Dim issueClass As EnumDocOverallIssueClass 1363cdf0e10cSrcweir 1364cdf0e10cSrcweir Dim index As Integer 1365cdf0e10cSrcweir For index = 1 To aAnalysis.Issues.count 1366cdf0e10cSrcweir Set myIssue = aAnalysis.Issues(index) 1367cdf0e10cSrcweir 1368cdf0e10cSrcweir If Not isMacroIssue(myIssue) Then 1369cdf0e10cSrcweir issueClass = getDocIssueClassification(logWb, myIssue) 1370cdf0e10cSrcweir CountDocIssuesForDoc issueClass, aAnalysis 1371cdf0e10cSrcweir SetOverallDocIssueClassification issueClass, aAnalysis 1372cdf0e10cSrcweir End If 1373cdf0e10cSrcweir 1374cdf0e10cSrcweir Set myIssue = Nothing 1375cdf0e10cSrcweir Next index 1376cdf0e10cSrcweir 1377cdf0e10cSrcweirFinalExit: 1378cdf0e10cSrcweir Exit Sub 1379cdf0e10cSrcweir 1380cdf0e10cSrcweirHandleErrors: 1381cdf0e10cSrcweir WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1382cdf0e10cSrcweir Resume FinalExit 1383cdf0e10cSrcweirEnd Sub 1384cdf0e10cSrcweir 1385cdf0e10cSrcweirFunction ProcessIssuesAndWriteDocIssueDetails(logWb As WorkBook, wsIssueDetails As Worksheet, DetailsRow As Long, _ 1386cdf0e10cSrcweir aAnalysis As DocumentAnalysis, fileName As String) As Long 1387cdf0e10cSrcweir On Error GoTo HandleErrors 1388cdf0e10cSrcweir Dim currentFunctionName As String 1389cdf0e10cSrcweir currentFunctionName = "ProcessIssueAndWriteDocIssueDetails" 1390cdf0e10cSrcweir 1391cdf0e10cSrcweir Dim myIssue As IssueInfo 1392cdf0e10cSrcweir Dim rowIndex As Long 1393cdf0e10cSrcweir Dim issueClass As EnumDocOverallIssueClass 1394cdf0e10cSrcweir Dim issueCost As Long 1395cdf0e10cSrcweir 1396cdf0e10cSrcweir rowIndex = DetailsRow 1397cdf0e10cSrcweir 1398cdf0e10cSrcweir Dim index As Integer 1399cdf0e10cSrcweir For index = 1 To aAnalysis.Issues.count 1400cdf0e10cSrcweir Set myIssue = aAnalysis.Issues(index) 1401cdf0e10cSrcweir 1402cdf0e10cSrcweir ' Process Document Issues and Costs for the Document 1403cdf0e10cSrcweir ' Will be output to List of Documents sheet by WriteDocProperties( ) 1404cdf0e10cSrcweir If Not isMacroIssue(myIssue) Then 1405cdf0e10cSrcweir issueClass = getDocIssueClassification(logWb, myIssue) 1406cdf0e10cSrcweir CountDocIssuesForDoc issueClass, aAnalysis 1407cdf0e10cSrcweir SetOverallDocIssueClassification issueClass, aAnalysis 1408cdf0e10cSrcweir issueCost = getDocIssueCost(logWb, aAnalysis, myIssue) 1409cdf0e10cSrcweir aAnalysis.DocIssuesCosts = aAnalysis.DocIssuesCosts + issueCost 1410cdf0e10cSrcweir If myIssue.Preparable Then 1411cdf0e10cSrcweir aAnalysis.PreparableIssuesCosts = aAnalysis.PreparableIssuesCosts + issueCost 1412cdf0e10cSrcweir End If 1413cdf0e10cSrcweir End If 1414cdf0e10cSrcweir 1415cdf0e10cSrcweir 'Collate Issue and Factor counts across all Documents 1416cdf0e10cSrcweir 'Will be output to the Issues Analyzed sheet by WriteIssueCounts( ) 1417cdf0e10cSrcweir CollateIssueAndFactorCountsAcrossAllDocs aAnalysis, myIssue, fileName 1418cdf0e10cSrcweir 1419cdf0e10cSrcweir OutputCommonIssueDetails wsIssueDetails, rowIndex, aAnalysis, myIssue, fileName 1420cdf0e10cSrcweir OutputCommonIssueAttributes wsIssueDetails, rowIndex, myIssue 1421cdf0e10cSrcweir rowIndex = rowIndex + 1 1422cdf0e10cSrcweir Set myIssue = Nothing 1423cdf0e10cSrcweir Next index 1424cdf0e10cSrcweir 1425cdf0e10cSrcweir ProcessIssuesAndWriteDocIssueDetails = rowIndex 1426cdf0e10cSrcweir 1427cdf0e10cSrcweirFinalExit: 1428cdf0e10cSrcweir Exit Function 1429cdf0e10cSrcweir 1430cdf0e10cSrcweirHandleErrors: 1431cdf0e10cSrcweir WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1432cdf0e10cSrcweir Resume FinalExit 1433cdf0e10cSrcweirEnd Function 1434cdf0e10cSrcweir 1435cdf0e10cSrcweirFunction getDocIssueCost(logWb As WorkBook, aAnalysis As DocumentAnalysis, myIssue As IssueInfo) As Long 1436cdf0e10cSrcweir On Error GoTo HandleErrors 1437cdf0e10cSrcweir Dim currentFunctionName As String 1438cdf0e10cSrcweir currentFunctionName = "getDocIssueCost" 1439cdf0e10cSrcweir 1440cdf0e10cSrcweir Dim issueKey As String 1441cdf0e10cSrcweir Dim ret As Long 1442cdf0e10cSrcweir ret = 0 1443cdf0e10cSrcweir 1444cdf0e10cSrcweir issueKey = getAppSpecificApplicationName & "_" & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML 1445cdf0e10cSrcweir 1446cdf0e10cSrcweir ret = getIssueValueFromXLSorDict(logWb, aAnalysis, mIssuesCostDict, issueKey, 1, CCOST_COL_OFFSET) 1447cdf0e10cSrcweir 1448cdf0e10cSrcweirFinalExit: 1449cdf0e10cSrcweir getDocIssueCost = ret 1450cdf0e10cSrcweir Exit Function 1451cdf0e10cSrcweir 1452cdf0e10cSrcweirHandleErrors: 1453cdf0e10cSrcweir ret = 0 1454cdf0e10cSrcweir WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1455cdf0e10cSrcweir Resume FinalExit 1456cdf0e10cSrcweirEnd Function 1457cdf0e10cSrcweirFunction getMacroIssueCosts(logWb As WorkBook, aAnalysis As DocumentAnalysis) As Long 1458cdf0e10cSrcweir 'Error handling not required 1459cdf0e10cSrcweir getMacroIssueCosts = getVBAMacroIssueCost(logWb, aAnalysis) '+ getMacroExtRefIssueCost(logWb, aAnalysis) 1460cdf0e10cSrcweir 'NOTE: Currently not counting External Refs as Macro Cost 1461cdf0e10cSrcweir 'could be added if porting off Windows 1462cdf0e10cSrcweir 1463cdf0e10cSrcweirEnd Function 1464cdf0e10cSrcweir 1465cdf0e10cSrcweirFunction getVBAMacroIssueCost(logWb As WorkBook, aAnalysis As DocumentAnalysis) As Long 1466cdf0e10cSrcweir Const CMACRO_ROW_OFFSET_UNIQUE_LINES_COST = 4 1467cdf0e10cSrcweir Const CMACRO_ROW_OFFSET_USER_FORMS_COUNT_COST = 5 1468cdf0e10cSrcweir Const CMACRO_ROW_OFFSET_USER_FORMS_CONTROL_COUNT_COST = 6 1469cdf0e10cSrcweir Const CMACRO_ROW_OFFSET_USER_FORMS_CONTROL_TYPE_COUNT_COST = 7 1470cdf0e10cSrcweir 1471cdf0e10cSrcweir Const CMACRO_NUM_OF_LINES_FACTOR_KEY = "_UniqueLineCount" 1472cdf0e10cSrcweir Const CMACRO_USER_FORMS_COUNT_FACTOR_KEY = "_UserFormsCount" 1473cdf0e10cSrcweir Const CMACRO_USER_FORMS_CONTROL_COUNT_FACTOR_KEY = "_UserFormsControlCount" 1474cdf0e10cSrcweir Const CMACRO_USER_FORMS_CONTROL_TYPE_COUNT_FACTOR_KEY = "_UserFormsControlTypeCount" 1475cdf0e10cSrcweir 1476cdf0e10cSrcweir On Error GoTo HandleErrors 1477cdf0e10cSrcweir Dim currentFunctionName As String 1478cdf0e10cSrcweir currentFunctionName = "getVBAMacroIssueCost" 1479cdf0e10cSrcweir 1480cdf0e10cSrcweir Dim baseIssueKey As String 1481cdf0e10cSrcweir Dim ret As Long 1482cdf0e10cSrcweir ret = 0 1483cdf0e10cSrcweir 1484cdf0e10cSrcweir If Not aAnalysis.HasMacros Then GoTo FinalExit 1485cdf0e10cSrcweir 1486cdf0e10cSrcweir 'Fetch VBA Macro Cost Factors - if required 1487cdf0e10cSrcweir baseIssueKey = getAppSpecificApplicationName & "_" & CSTR_ISSUE_VBA_MACROS & "_" & CSTR_SUBISSUE_PROPERTIES 1488cdf0e10cSrcweir 1489cdf0e10cSrcweir 'Num Lines - Costing taken from "Lines in Unique Modules" 1490cdf0e10cSrcweir If aAnalysis.MacroTotalNumLines > 0 Then 1491cdf0e10cSrcweir ret = ret + aAnalysis.MacroTotalNumLines * _ 1492cdf0e10cSrcweir getValueFromXLSorDict(logWb, aAnalysis, mIssuesCostDict, _ 1493cdf0e10cSrcweir baseIssueKey & CMACRO_NUM_OF_LINES_FACTOR_KEY, baseIssueKey, _ 1494cdf0e10cSrcweir CMACRO_ROW_OFFSET_UNIQUE_LINES_COST, CCOST_COL_OFFSET) 1495cdf0e10cSrcweir End If 1496cdf0e10cSrcweir 'User Forms Count 1497cdf0e10cSrcweir If aAnalysis.MacroNumUserForms > 0 Then 1498cdf0e10cSrcweir ret = ret + aAnalysis.MacroNumUserForms * _ 1499cdf0e10cSrcweir getValueFromXLSorDict(logWb, aAnalysis, mIssuesCostDict, _ 1500cdf0e10cSrcweir baseIssueKey & CMACRO_USER_FORMS_COUNT_FACTOR_KEY, baseIssueKey, _ 1501cdf0e10cSrcweir CMACRO_ROW_OFFSET_USER_FORMS_COUNT_COST, CCOST_COL_OFFSET) 1502cdf0e10cSrcweir End If 1503cdf0e10cSrcweir 'User Forms Control Count 1504cdf0e10cSrcweir If aAnalysis.MacroNumUserFormControls > 0 Then 1505cdf0e10cSrcweir ret = ret + aAnalysis.MacroNumUserFormControls * _ 1506cdf0e10cSrcweir getValueFromXLSorDict(logWb, aAnalysis, mIssuesCostDict, _ 1507cdf0e10cSrcweir baseIssueKey & CMACRO_USER_FORMS_CONTROL_COUNT_FACTOR_KEY, baseIssueKey, _ 1508cdf0e10cSrcweir CMACRO_ROW_OFFSET_USER_FORMS_CONTROL_COUNT_COST, CCOST_COL_OFFSET) 1509cdf0e10cSrcweir End If 1510cdf0e10cSrcweir 'User Forms Control Type Count 1511cdf0e10cSrcweir If aAnalysis.MacroNumUserFormControlTypes > 0 Then 1512cdf0e10cSrcweir ret = ret + aAnalysis.MacroNumUserFormControlTypes * getValueFromXLSorDict(logWb, aAnalysis, mIssuesCostDict, _ 1513cdf0e10cSrcweir baseIssueKey & CMACRO_USER_FORMS_CONTROL_TYPE_COUNT_FACTOR_KEY, baseIssueKey, CMACRO_ROW_OFFSET_USER_FORMS_CONTROL_TYPE_COUNT_COST, CCOST_COL_OFFSET) 1514cdf0e10cSrcweir End If 1515cdf0e10cSrcweir 1516cdf0e10cSrcweir 1517cdf0e10cSrcweirFinalExit: 1518cdf0e10cSrcweir getVBAMacroIssueCost = ret 1519cdf0e10cSrcweir Exit Function 1520cdf0e10cSrcweir 1521cdf0e10cSrcweirHandleErrors: 1522cdf0e10cSrcweir ret = 0 1523cdf0e10cSrcweir WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1524cdf0e10cSrcweir Resume FinalExit 1525cdf0e10cSrcweirEnd Function 1526cdf0e10cSrcweirFunction getMacroExtRefIssueCost(logWb As WorkBook, aAnalysis As DocumentAnalysis) As Long 1527cdf0e10cSrcweir Const CMACRO_ROW_OFFSET_NUM_EXTERNAL_REFS_COST = 2 1528cdf0e10cSrcweir Const CMACRO_NUM_EXTERNAL_REFS_FACTOR_KEY = "_ExternalRefs" 1529cdf0e10cSrcweir 1530cdf0e10cSrcweir On Error GoTo HandleErrors 1531cdf0e10cSrcweir Dim currentFunctionName As String 1532cdf0e10cSrcweir currentFunctionName = "getMacroExtRefIssueCost" 1533cdf0e10cSrcweir Dim baseIssueKey As String 1534cdf0e10cSrcweir Dim ret As Long 1535cdf0e10cSrcweir ret = 0 1536cdf0e10cSrcweir 1537cdf0e10cSrcweir If aAnalysis.MacroNumExternalRefs <= 0 Then GoTo FinalExit 1538cdf0e10cSrcweir 1539cdf0e10cSrcweir 'Fetch External Ref Cost Factors 1540cdf0e10cSrcweir baseIssueKey = getAppSpecificApplicationName & "_" & CSTR_ISSUE_PORTABILITY & "_" & _ 1541cdf0e10cSrcweir CSTR_SUBISSUE_EXTERNAL_REFERENCES_IN_MACRO 1542cdf0e10cSrcweir ret = ret + aAnalysis.MacroNumExternalRefs * _ 1543cdf0e10cSrcweir getValueFromXLSorDict(logWb, aAnalysis, mIssuesCostDict, _ 1544cdf0e10cSrcweir baseIssueKey & CMACRO_NUM_EXTERNAL_REFS_FACTOR_KEY, baseIssueKey, _ 1545cdf0e10cSrcweir CMACRO_ROW_OFFSET_NUM_EXTERNAL_REFS_COST, CCOST_COL_OFFSET) 1546cdf0e10cSrcweir 1547cdf0e10cSrcweirFinalExit: 1548cdf0e10cSrcweir getMacroExtRefIssueCost = ret 1549cdf0e10cSrcweir Exit Function 1550cdf0e10cSrcweir 1551cdf0e10cSrcweirHandleErrors: 1552cdf0e10cSrcweir ret = 0 1553cdf0e10cSrcweir WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1554cdf0e10cSrcweir Resume FinalExit 1555cdf0e10cSrcweirEnd Function 1556cdf0e10cSrcweirFunction getIssueValueFromXLSorDict(logWb As WorkBook, aAnalysis As DocumentAnalysis, dict As Scripting.Dictionary, _ 1557cdf0e10cSrcweir key As String, row As Long, column As Long) As Long 1558cdf0e10cSrcweir 'Error handling not required 1559cdf0e10cSrcweir getIssueValueFromXLSorDict = getValueFromXLSorDict(logWb, aAnalysis, dict, key, key, row, column) 1560cdf0e10cSrcweirEnd Function 1561cdf0e10cSrcweir 1562cdf0e10cSrcweirFunction getValueFromXLSorDict(logWb As WorkBook, aAnalysis As DocumentAnalysis, dict As Scripting.Dictionary, _ 1563cdf0e10cSrcweir dictKey As String, xlsKey As String, row As Long, column As Long) As Long 1564cdf0e10cSrcweir On Error GoTo HandleErrors 1565cdf0e10cSrcweir Dim currentFunctionName As String 1566cdf0e10cSrcweir currentFunctionName = "getValueFromXLSorDict" 1567cdf0e10cSrcweir 1568cdf0e10cSrcweir Dim ret As Long 1569cdf0e10cSrcweir ret = 0 1570cdf0e10cSrcweir 1571cdf0e10cSrcweir If dict.Exists(dictKey) Then 1572cdf0e10cSrcweir ret = dict.item(dictKey) 1573cdf0e10cSrcweir Else 1574cdf0e10cSrcweir On Error Resume Next 1575cdf0e10cSrcweir ret = logWb.Names(xlsKey).RefersToRange.Cells(row, column).value 1576cdf0e10cSrcweir 'Log as error missing key 1577cdf0e10cSrcweir If Err.Number <> 0 Then 1578cdf0e10cSrcweir WriteDebug currentFunctionName & _ 1579cdf0e10cSrcweir " : Issue Cost Key - " & xlsKey & ": label missing from results.xlt Costs sheet, check sheet and add/ check spelling label" & Err.Number & " " & Err.Description & " " & Err.Source 1580cdf0e10cSrcweir WriteDebug currentFunctionName & " : dictKey " & dictKey & " : xlsKey " & xlsKey & " : " & Err.Number & " " & Err.Description & " " & Err.Source 1581cdf0e10cSrcweir ret = 0 1582cdf0e10cSrcweir End If 1583cdf0e10cSrcweir On Error GoTo HandleErrors 1584cdf0e10cSrcweir dict.Add dictKey, ret 1585cdf0e10cSrcweir End If 1586cdf0e10cSrcweir 1587cdf0e10cSrcweirFinalExit: 1588cdf0e10cSrcweir getValueFromXLSorDict = ret 1589cdf0e10cSrcweir Exit Function 1590cdf0e10cSrcweir 1591cdf0e10cSrcweirHandleErrors: 1592cdf0e10cSrcweir ret = 0 1593cdf0e10cSrcweir WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1594cdf0e10cSrcweir Resume FinalExit 1595cdf0e10cSrcweirEnd Function 1596cdf0e10cSrcweirFunction isMacroIssue(myIssue As IssueInfo) 1597cdf0e10cSrcweir 'Error handling not required 1598cdf0e10cSrcweir isMacroIssue = False 1599cdf0e10cSrcweir 1600cdf0e10cSrcweir If myIssue.IssueTypeXML = CSTR_ISSUE_VBA_MACROS Or _ 1601cdf0e10cSrcweir (myIssue.IssueTypeXML = CSTR_ISSUE_PORTABILITY And _ 1602cdf0e10cSrcweir myIssue.SubTypeXML = CSTR_SUBISSUE_EXTERNAL_REFERENCES_IN_MACRO) Then 1603cdf0e10cSrcweir isMacroIssue = True 1604cdf0e10cSrcweir End If 1605cdf0e10cSrcweirEnd Function 1606cdf0e10cSrcweirSub CountDocIssuesForDoc(issueClass As EnumDocOverallIssueClass, aAnalysis As DocumentAnalysis) 1607cdf0e10cSrcweir 'Error handling not required 1608cdf0e10cSrcweir 1609cdf0e10cSrcweir If issueClass = enMinor Then 1610cdf0e10cSrcweir aAnalysis.MinorIssuesCount = aAnalysis.MinorIssuesCount + 1 1611cdf0e10cSrcweir End If 1612cdf0e10cSrcweir ' Macro issues are counted during analysis 1613cdf0e10cSrcweir ' Complex issues is calculated from: mIssues.count - mMinorIssuesCount - mMacroIssuesCount 1614cdf0e10cSrcweirEnd Sub 1615cdf0e10cSrcweirSub SetOverallDocIssueClassification(issueClass As EnumDocOverallIssueClass, aAnalysis As DocumentAnalysis) 1616cdf0e10cSrcweir 'Error handling not required 1617cdf0e10cSrcweir 1618cdf0e10cSrcweir If aAnalysis.DocOverallIssueClass = enComplex Then Exit Sub 1619cdf0e10cSrcweir 1620cdf0e10cSrcweir If issueClass = enComplex Then 1621cdf0e10cSrcweir aAnalysis.DocOverallIssueClass = enComplex 1622cdf0e10cSrcweir Else 1623cdf0e10cSrcweir aAnalysis.DocOverallIssueClass = enMinor 1624cdf0e10cSrcweir End If 1625cdf0e10cSrcweirEnd Sub 1626cdf0e10cSrcweirFunction getDocIssueClassification(logWb As WorkBook, myIssue As IssueInfo) As EnumDocOverallIssueClass 1627cdf0e10cSrcweir On Error GoTo HandleErrors 1628cdf0e10cSrcweir Dim currentFunctionName As String 1629cdf0e10cSrcweir currentFunctionName = "getDocIssueClassification" 1630cdf0e10cSrcweir Dim issueKey As String 1631cdf0e10cSrcweir Dim bRet As Boolean 1632cdf0e10cSrcweir bRet = False 1633cdf0e10cSrcweir getDocIssueClassification = enMinor 1634cdf0e10cSrcweir 1635cdf0e10cSrcweir issueKey = getAppSpecificApplicationName & "_" & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML 1636cdf0e10cSrcweir If mIssuesClassificationDict.Exists(issueKey) Then 1637cdf0e10cSrcweir bRet = mIssuesClassificationDict.item(issueKey) 1638cdf0e10cSrcweir Else 1639cdf0e10cSrcweir On Error Resume Next 1640cdf0e10cSrcweir bRet = logWb.Names(issueKey).RefersToRange.Cells(1, 0).value 1641cdf0e10cSrcweir 'Log as error missing key 1642cdf0e10cSrcweir If Err.Number <> 0 Then 1643cdf0e10cSrcweir WriteDebug currentFunctionName & _ 1644cdf0e10cSrcweir " : Issue Cost Key - " & issueKey & ": label missing from results.xlt Costs sheet, check sheet and add/ check spelling label" & Err.Number & " " & Err.Description & " " & Err.Source 1645cdf0e10cSrcweir bRet = False 1646cdf0e10cSrcweir End If 1647cdf0e10cSrcweir On Error GoTo HandleErrors 1648cdf0e10cSrcweir mIssuesClassificationDict.Add issueKey, bRet 1649cdf0e10cSrcweir End If 1650cdf0e10cSrcweir 1651cdf0e10cSrcweir 1652cdf0e10cSrcweirFinalExit: 1653cdf0e10cSrcweir If bRet Then 1654cdf0e10cSrcweir getDocIssueClassification = enComplex 1655cdf0e10cSrcweir End If 1656cdf0e10cSrcweir Exit Function 1657cdf0e10cSrcweir 1658cdf0e10cSrcweirHandleErrors: 1659cdf0e10cSrcweir bRet = False 1660cdf0e10cSrcweir WriteDebug currentFunctionName & " : issueKey " & issueKey & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1661cdf0e10cSrcweir Resume FinalExit 1662cdf0e10cSrcweirEnd Function 1663cdf0e10cSrcweir 1664cdf0e10cSrcweirFunction getDocOverallIssueClassificationAsString(docIssueClass As EnumDocOverallIssueClass) As String 1665cdf0e10cSrcweir Dim Str As String 1666cdf0e10cSrcweir 'Error handling not required 1667cdf0e10cSrcweir 1668cdf0e10cSrcweir Select Case docIssueClass 1669cdf0e10cSrcweir Case enComplex 1670cdf0e10cSrcweir Str = RID_STR_COMMON_ISSUE_CLASS_COMPLEX 1671cdf0e10cSrcweir Case enMinor 1672cdf0e10cSrcweir Str = RID_STR_COMMON_ISSUE_CLASS_MINOR 1673cdf0e10cSrcweir Case Else 1674cdf0e10cSrcweir Str = RID_STR_COMMON_ISSUE_CLASS_NONE 1675cdf0e10cSrcweir End Select 1676cdf0e10cSrcweir 1677cdf0e10cSrcweir getDocOverallIssueClassificationAsString = Str 1678cdf0e10cSrcweirEnd Function 1679cdf0e10cSrcweir 1680cdf0e10cSrcweirPublic Function getDocOverallMacroClassAsString(docMacroClass As EnumDocOverallMacroClass) As String 1681cdf0e10cSrcweir Dim Str As String 1682cdf0e10cSrcweir 'Error handling not required 1683cdf0e10cSrcweir 1684cdf0e10cSrcweir Select Case docMacroClass 1685cdf0e10cSrcweir Case enMacroComplex 1686cdf0e10cSrcweir Str = RID_STR_COMMON_MACRO_CLASS_COMPLEX 1687cdf0e10cSrcweir Case enMacroMedium 1688cdf0e10cSrcweir Str = RID_STR_COMMON_MACRO_CLASS_MEDIUM 1689cdf0e10cSrcweir Case enMacroSimple 1690cdf0e10cSrcweir Str = RID_STR_COMMON_MACRO_CLASS_SIMPLE 1691cdf0e10cSrcweir Case Else 1692cdf0e10cSrcweir Str = RID_STR_COMMON_MACRO_CLASS_NONE 1693cdf0e10cSrcweir End Select 1694cdf0e10cSrcweir 1695cdf0e10cSrcweir getDocOverallMacroClassAsString = Str 1696cdf0e10cSrcweirEnd Function 1697cdf0e10cSrcweir 1698cdf0e10cSrcweirFunction WriteDocRefDetails(wsRefDetails As Worksheet, DetailsRow As Long, _ 1699cdf0e10cSrcweir aAnalysis As DocumentAnalysis, fileName As String) As Long 1700cdf0e10cSrcweir On Error GoTo HandleErrors 1701cdf0e10cSrcweir Dim currentFunctionName As String 1702cdf0e10cSrcweir currentFunctionName = "WriteDocRefDetails" 1703cdf0e10cSrcweir 1704cdf0e10cSrcweir Dim myIssue As IssueInfo 1705cdf0e10cSrcweir Dim rowIndex As Long 1706cdf0e10cSrcweir rowIndex = DetailsRow 1707cdf0e10cSrcweir 1708cdf0e10cSrcweir Dim index As Integer 1709cdf0e10cSrcweir 1710cdf0e10cSrcweir 'Output References for Docs with Macros 1711cdf0e10cSrcweir If aAnalysis.HasMacros And (aAnalysis.References.count > 0) Then 1712cdf0e10cSrcweir For index = 1 To aAnalysis.References.count 1713cdf0e10cSrcweir Set myIssue = aAnalysis.References(index) 1714cdf0e10cSrcweir OutputReferenceAttributes wsRefDetails, rowIndex, aAnalysis, myIssue, fileName 1715cdf0e10cSrcweir rowIndex = rowIndex + 1 1716cdf0e10cSrcweir Set myIssue = Nothing 1717cdf0e10cSrcweir Next index 1718cdf0e10cSrcweir End If 1719cdf0e10cSrcweir 1720cdf0e10cSrcweir WriteDocRefDetails = rowIndex 1721cdf0e10cSrcweir 1722cdf0e10cSrcweirFinalExit: 1723cdf0e10cSrcweir Exit Function 1724cdf0e10cSrcweir 1725cdf0e10cSrcweirHandleErrors: 1726cdf0e10cSrcweir WriteDebug currentFunctionName & _ 1727cdf0e10cSrcweir " : path " & aAnalysis.name & ": " & _ 1728cdf0e10cSrcweir " : row " & DetailsRow & ": " & _ 1729cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 1730cdf0e10cSrcweir Resume FinalExit 1731cdf0e10cSrcweirEnd Function 1732cdf0e10cSrcweirSub OutputReferenceAttributes(wsIssueDetails As Worksheet, rowIndex As Long, _ 1733cdf0e10cSrcweir aAnalysis As DocumentAnalysis, myIssue As IssueInfo, fileName As String) 1734cdf0e10cSrcweir On Error GoTo HandleErrors 1735cdf0e10cSrcweir Dim currentFunctionName As String 1736cdf0e10cSrcweir currentFunctionName = "OutputReferenceAttributes" 1737cdf0e10cSrcweir 1738cdf0e10cSrcweir Dim strAttributes As String 1739cdf0e10cSrcweir 1740cdf0e10cSrcweir With myIssue 1741cdf0e10cSrcweir SetWorksheetCellValueToString wsIssueDetails, rowIndex, CREF_DETDOCNAME, fileName 1742cdf0e10cSrcweir SetWorksheetCellValueToString wsIssueDetails, rowIndex, CREF_DETDOCAPPLICATION, aAnalysis.Application 1743cdf0e10cSrcweir 1744cdf0e10cSrcweir strAttributes = .Values(RID_STR_COMMON_ATTRIBUTE_MAJOR) & "." & .Values(RID_STR_COMMON_ATTRIBUTE_MINOR) 1745cdf0e10cSrcweir strAttributes = IIf(strAttributes = "0.0" Or strAttributes = ".", .Values(RID_STR_COMMON_ATTRIBUTE_NAME), _ 1746cdf0e10cSrcweir .Values(RID_STR_COMMON_ATTRIBUTE_NAME) & " " & .Values(RID_STR_COMMON_ATTRIBUTE_MAJOR) & _ 1747cdf0e10cSrcweir "." & .Values(RID_STR_COMMON_ATTRIBUTE_MINOR)) 1748cdf0e10cSrcweir SetWorksheetCellValueToString wsIssueDetails, rowIndex, CREF_DETREFERENCE, strAttributes 1749cdf0e10cSrcweir 1750cdf0e10cSrcweir If .Values(RID_STR_COMMON_ATTRIBUTE_TYPE) = RID_STR_COMMON_ATTRIBUTE_PROJECT Then 1751cdf0e10cSrcweir SetWorksheetCellValueToString wsIssueDetails, rowIndex, CREF_DETDESCRIPTION, RID_STR_COMMON_ATTRIBUTE_PROJECT 1752cdf0e10cSrcweir Else 1753cdf0e10cSrcweir SetWorksheetCellValueToString wsIssueDetails, rowIndex, CREF_DETDESCRIPTION, _ 1754cdf0e10cSrcweir IIf(.Values(RID_STR_COMMON_ATTRIBUTE_DESCRIPTION) <> "", .Values(RID_STR_COMMON_ATTRIBUTE_DESCRIPTION), RID_STR_COMMON_NA) 1755cdf0e10cSrcweir End If 1756cdf0e10cSrcweir 1757cdf0e10cSrcweir 1758cdf0e10cSrcweir If .Values(RID_STR_COMMON_ATTRIBUTE_ISBROKEN) <> RID_STR_COMMON_ATTRIBUTE_BROKEN Then 1759cdf0e10cSrcweir SetWorksheetCellValueToString wsIssueDetails, rowIndex, CREF_DETLOCATION, _ 1760cdf0e10cSrcweir .Values(RID_STR_COMMON_ATTRIBUTE_FILE) 1761cdf0e10cSrcweir Else 1762cdf0e10cSrcweir SetWorksheetCellValueToString wsIssueDetails, rowIndex, CREF_DETLOCATION, _ 1763cdf0e10cSrcweir RID_STR_COMMON_NA 1764cdf0e10cSrcweir End If 1765cdf0e10cSrcweir 1766cdf0e10cSrcweir 'Reference Details 1767cdf0e10cSrcweir strAttributes = RID_STR_COMMON_ATTRIBUTE_TYPE & ": " & .Values(RID_STR_COMMON_ATTRIBUTE_TYPE) & vbLf 1768cdf0e10cSrcweir strAttributes = strAttributes & RID_STR_COMMON_ATTRIBUTE_PROPERTIES & ": " & _ 1769cdf0e10cSrcweir .Values(RID_STR_COMMON_ATTRIBUTE_BUILTIN) & " " & .Values(RID_STR_COMMON_ATTRIBUTE_ISBROKEN) 1770cdf0e10cSrcweir strAttributes = IIf(.Values(RID_STR_COMMON_ATTRIBUTE_GUID) <> "", _ 1771cdf0e10cSrcweir strAttributes & vbLf & RID_STR_COMMON_ATTRIBUTE_GUID & ": " & .Values(RID_STR_COMMON_ATTRIBUTE_GUID), _ 1772cdf0e10cSrcweir strAttributes) 1773cdf0e10cSrcweir SetWorksheetCellValueToString wsIssueDetails, rowIndex, CREF_DETATTRIBUTES, strAttributes 1774cdf0e10cSrcweir 1775cdf0e10cSrcweir SetWorksheetCellValueToString wsIssueDetails, rowIndex, CREF_DETNAMEANDPATH, aAnalysis.name 1776cdf0e10cSrcweir End With 1777cdf0e10cSrcweirFinalExit: 1778cdf0e10cSrcweir Exit Sub 1779cdf0e10cSrcweir 1780cdf0e10cSrcweirHandleErrors: 1781cdf0e10cSrcweir WriteDebug currentFunctionName & _ 1782cdf0e10cSrcweir " : path " & aAnalysis.name & ": " & _ 1783cdf0e10cSrcweir " : rowIndex " & rowIndex & ": " & _ 1784cdf0e10cSrcweir " : myIssue " & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML & ": " & _ 1785cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 1786cdf0e10cSrcweir Resume FinalExit 1787cdf0e10cSrcweirEnd Sub 1788cdf0e10cSrcweirSub OutputCommonIssueAttributes(wsIssueDetails As Worksheet, rowIndex As Long, _ 1789cdf0e10cSrcweir myIssue As IssueInfo) 1790cdf0e10cSrcweir On Error GoTo HandleErrors 1791cdf0e10cSrcweir Dim currentFunctionName As String 1792cdf0e10cSrcweir currentFunctionName = "OutputCommonIssueAttributes" 1793cdf0e10cSrcweir 1794cdf0e10cSrcweir Dim index As Integer 1795cdf0e10cSrcweir Dim strAttributes As String 1796cdf0e10cSrcweir 1797cdf0e10cSrcweir strAttributes = "" 1798cdf0e10cSrcweir For index = 1 To myIssue.Attributes.count 1799cdf0e10cSrcweir strAttributes = strAttributes & myIssue.Attributes(index) & " - " & _ 1800cdf0e10cSrcweir myIssue.Values(index) 1801cdf0e10cSrcweir strAttributes = strAttributes & IIf(index <> myIssue.Attributes.count, vbLf, "") 1802cdf0e10cSrcweir 1803cdf0e10cSrcweir Next index 1804cdf0e10cSrcweir SetWorksheetCellValueToString wsIssueDetails, rowIndex, CISSUE_DETATTRIBUTES, strAttributes 1805cdf0e10cSrcweir 1806cdf0e10cSrcweirFinalExit: 1807cdf0e10cSrcweir Exit Sub 1808cdf0e10cSrcweir 1809cdf0e10cSrcweirHandleErrors: 1810cdf0e10cSrcweir WriteDebug currentFunctionName & _ 1811cdf0e10cSrcweir " : rowIndex " & rowIndex & ": " & _ 1812cdf0e10cSrcweir " : myIssue " & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML & ": " & _ 1813cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 1814cdf0e10cSrcweir Resume FinalExit 1815cdf0e10cSrcweirEnd Sub 1816cdf0e10cSrcweir'Store issue cost and factor costs across all documents 1817cdf0e10cSrcweirSub CollateIssueAndFactorCountsAcrossAllDocs(aAnalysis As DocumentAnalysis, myIssue As IssueInfo, fileName As String) 1818cdf0e10cSrcweir Const CSTR_USER_FORM = "User Form" 1819cdf0e10cSrcweir On Error GoTo HandleErrors 1820cdf0e10cSrcweir Dim currentFunctionName As String 1821cdf0e10cSrcweir currentFunctionName = "CollateIssueAndFactorCountsAcrossAllDocs" 1822cdf0e10cSrcweir 1823cdf0e10cSrcweir 'Don't want to cost ISSUE_INFORMATION issues 1824cdf0e10cSrcweir If myIssue.IssueTypeXML = CSTR_ISSUE_INFORMATION Then Exit Sub 1825cdf0e10cSrcweir 1826cdf0e10cSrcweir Dim issueKey As String 1827cdf0e10cSrcweir issueKey = getAppSpecificApplicationName & "_" & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML 1828cdf0e10cSrcweir 1829cdf0e10cSrcweir 'Store costing metrics for Issue 1830cdf0e10cSrcweir AddIssueAndOneToDict issueKey 1831cdf0e10cSrcweir 1832cdf0e10cSrcweir 'Store prepeared issue for costing metrics 1833cdf0e10cSrcweir If myIssue.Preparable Then 1834cdf0e10cSrcweir AddPreparedIssueAndOneToDict issueKey & "_Prepared" 1835cdf0e10cSrcweir End If 1836cdf0e10cSrcweir 1837cdf0e10cSrcweir 'Additional costing Factors output for VB macros 1838cdf0e10cSrcweir If (myIssue.IssueTypeXML = CSTR_ISSUE_VBA_MACROS) And _ 1839cdf0e10cSrcweir (myIssue.SubTypeXML <> CSTR_SUBISSUE_MACRO_PASSWORD_PROTECTION) Then 1840cdf0e10cSrcweir 1841cdf0e10cSrcweir 'Unique Macro Module and Line count 1842cdf0e10cSrcweir AddMacroModuleHashToMacroDict myIssue 1843cdf0e10cSrcweir 1844cdf0e10cSrcweir 'Line count 1845cdf0e10cSrcweir AddIssueAndValToDict issueKey & "_" & CSTR_SUBISSUE_VBA_MACROS_NUMLINES, myIssue, _ 1846cdf0e10cSrcweir RID_STR_COMMON_ATTRIBUTE_NUMBER_OF_LINES 1847cdf0e10cSrcweir 1848cdf0e10cSrcweir 'User From info 1849cdf0e10cSrcweir If myIssue.SubLocation = CSTR_USER_FORM Then 1850cdf0e10cSrcweir AddIssueAndOneToDict issueKey & "_" & CSTR_SUBISSUE_VBA_MACROS_USERFORMS_COUNT 1851cdf0e10cSrcweir 1852cdf0e10cSrcweir AddIssueAndValToDict issueKey & "_" & CSTR_SUBISSUE_VBA_MACROS_USERFORMS_CONTROL_COUNT, myIssue, _ 1853cdf0e10cSrcweir RID_STR_COMMON_ATTRIBUTE_CONTROLS 1854cdf0e10cSrcweir End If 1855cdf0e10cSrcweir 'Additional costing Factors output for External References 1856cdf0e10cSrcweir ElseIf (myIssue.IssueTypeXML = CSTR_ISSUE_PORTABILITY And _ 1857cdf0e10cSrcweir myIssue.SubTypeXML = CSTR_SUBISSUE_EXTERNAL_REFERENCES_IN_MACRO) Then 1858cdf0e10cSrcweir 1859cdf0e10cSrcweir AddIssueAndValToDict issueKey & "_" & CSTR_SUBISSUE_EXTERNAL_REFERENCES_IN_MACRO_COUNT, myIssue, _ 1860cdf0e10cSrcweir RID_STR_COMMON_ATTRIBUTE_NON_PORTABLE_EXTERNAL_REFERENCES_COUNT 1861cdf0e10cSrcweir End If 1862cdf0e10cSrcweir 1863cdf0e10cSrcweirFinalExit: 1864cdf0e10cSrcweir Exit Sub 1865cdf0e10cSrcweir 1866cdf0e10cSrcweirHandleErrors: 1867cdf0e10cSrcweir WriteDebug currentFunctionName & _ 1868cdf0e10cSrcweir " : path " & aAnalysis.name & ": " & _ 1869cdf0e10cSrcweir " : myIssue " & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML & ": " & _ 1870cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 1871cdf0e10cSrcweir Resume FinalExit 1872cdf0e10cSrcweirEnd Sub 1873cdf0e10cSrcweir 1874cdf0e10cSrcweirSub OutputCommonIssueDetails(wsIssueDetails As Worksheet, rowIndex As Long, _ 1875cdf0e10cSrcweir aAnalysis As DocumentAnalysis, myIssue As IssueInfo, fileName As String) 1876cdf0e10cSrcweir Const CSTR_USER_FORM = "User Form" 1877cdf0e10cSrcweir On Error GoTo HandleErrors 1878cdf0e10cSrcweir Dim currentFunctionName As String 1879cdf0e10cSrcweir currentFunctionName = "OutputCommonIssueDetails" 1880cdf0e10cSrcweir 1881cdf0e10cSrcweir SetWorksheetCellValueToString wsIssueDetails, rowIndex, CISSUE_DETDOCNAME, fileName 1882cdf0e10cSrcweir SetWorksheetCellValueToString wsIssueDetails, rowIndex, CISSUE_DETDOCAPPLICATION, aAnalysis.Application 1883cdf0e10cSrcweir SetWorksheetCellValueToString wsIssueDetails, rowIndex, CISSUE_DETTYPE, myIssue.IssueType 1884cdf0e10cSrcweir SetWorksheetCellValueToString wsIssueDetails, rowIndex, CISSUE_DETSUBTYPE, myIssue.SubType 1885cdf0e10cSrcweir SetWorksheetCellValueToString wsIssueDetails, rowIndex, CISSUE_DETLOCATION, myIssue.Location 1886cdf0e10cSrcweir SetWorksheetCellValueToString wsIssueDetails, rowIndex, CISSUE_DETSUBLOCATION, _ 1887cdf0e10cSrcweir IIf(myIssue.SubLocation = "", RID_STR_COMMON_NA, myIssue.SubLocation) 1888cdf0e10cSrcweir SetWorksheetCellValueToVariant wsIssueDetails, rowIndex, CISSUE_DETLINE, _ 1889cdf0e10cSrcweir IIf(myIssue.Line = -1, RID_STR_COMMON_NA, myIssue.Line) 1890cdf0e10cSrcweir SetWorksheetCellValueToString wsIssueDetails, rowIndex, CISSUE_DETCOLUMN, _ 1891cdf0e10cSrcweir IIf(myIssue.column = "", RID_STR_COMMON_NA, myIssue.column) 1892cdf0e10cSrcweir SetWorksheetCellValueToString wsIssueDetails, rowIndex, CISSUE_DETNAMEANDPATH, aAnalysis.name 1893cdf0e10cSrcweir 1894cdf0e10cSrcweir 1895cdf0e10cSrcweirFinalExit: 1896cdf0e10cSrcweir Exit Sub 1897cdf0e10cSrcweir 1898cdf0e10cSrcweirHandleErrors: 1899cdf0e10cSrcweir WriteDebug currentFunctionName & _ 1900cdf0e10cSrcweir " : path " & aAnalysis.name & ": " & _ 1901cdf0e10cSrcweir " : rowIndex " & rowIndex & ": " & _ 1902cdf0e10cSrcweir " : myIssue " & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML & ": " & _ 1903cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 1904cdf0e10cSrcweir Resume FinalExit 1905cdf0e10cSrcweirEnd Sub 1906cdf0e10cSrcweir 1907cdf0e10cSrcweirSub AddIssueAndBoolValToDict(issueKey As String, issue As IssueInfo, valKey As String) 1908cdf0e10cSrcweir On Error GoTo HandleErrors 1909cdf0e10cSrcweir Dim currentFunctionName As String 1910cdf0e10cSrcweir currentFunctionName = "AddIssueAndBoolValToDict" 1911cdf0e10cSrcweir 1912cdf0e10cSrcweir If mIssuesDict.Exists(issueKey) Then 1913cdf0e10cSrcweir mIssuesDict.item(issueKey) = mIssuesDict.item(issueKey) + _ 1914cdf0e10cSrcweir IIf(issue.Values(valKey) > 0, 1, 0) 1915cdf0e10cSrcweir Else 1916cdf0e10cSrcweir mIssuesDict.Add issueKey, IIf(issue.Values(valKey) > 0, 1, 0) 1917cdf0e10cSrcweir End If 1918cdf0e10cSrcweirFinalExit: 1919cdf0e10cSrcweir Exit Sub 1920cdf0e10cSrcweir 1921cdf0e10cSrcweirHandleErrors: 1922cdf0e10cSrcweir WriteDebug currentFunctionName & _ 1923cdf0e10cSrcweir " : issueKey " & issueKey & ": " & _ 1924cdf0e10cSrcweir " : valKey " & valKey & ": " & _ 1925cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 1926cdf0e10cSrcweir Resume FinalExit 1927cdf0e10cSrcweirEnd Sub 1928cdf0e10cSrcweirSub AddIssueAndValToDict(issueKey As String, issue As IssueInfo, valKey As String) 1929cdf0e10cSrcweir On Error GoTo HandleErrors 1930cdf0e10cSrcweir Dim currentFunctionName As String 1931cdf0e10cSrcweir currentFunctionName = "AddIssueAndValToDict" 1932cdf0e10cSrcweir 1933cdf0e10cSrcweir If mIssuesDict.Exists(issueKey) Then 1934cdf0e10cSrcweir mIssuesDict.item(issueKey) = mIssuesDict.item(issueKey) + issue.Values(valKey) 1935cdf0e10cSrcweir Else 1936cdf0e10cSrcweir mIssuesDict.Add issueKey, issue.Values(valKey) 1937cdf0e10cSrcweir End If 1938cdf0e10cSrcweirFinalExit: 1939cdf0e10cSrcweir Exit Sub 1940cdf0e10cSrcweir 1941cdf0e10cSrcweirHandleErrors: 1942cdf0e10cSrcweir WriteDebug currentFunctionName & _ 1943cdf0e10cSrcweir " : issueKey " & issueKey & ": " & _ 1944cdf0e10cSrcweir " : valKey " & valKey & ": " & _ 1945cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 1946cdf0e10cSrcweir Resume FinalExit 1947cdf0e10cSrcweirEnd Sub 1948cdf0e10cSrcweir 1949cdf0e10cSrcweirSub AddMacroModuleHashToMacroDict(issue As IssueInfo) 1950cdf0e10cSrcweir On Error GoTo HandleErrors 1951cdf0e10cSrcweir Dim currentFunctionName As String 1952cdf0e10cSrcweir Dim issueKey As String 1953cdf0e10cSrcweir Dim issueVal As String 1954cdf0e10cSrcweir currentFunctionName = "AddMacroModuleHashToMacroDict" 1955cdf0e10cSrcweir 1956cdf0e10cSrcweir issueKey = issue.Values(RID_STR_COMMON_ATTRIBUTE_SIGNATURE) 1957cdf0e10cSrcweir If issueKey = RID_STR_COMMON_NA Then Exit Sub 1958cdf0e10cSrcweir 1959cdf0e10cSrcweir If Not mMacroDict.Exists(issueKey) Then 1960cdf0e10cSrcweir mMacroDict.Add issueKey, issue.Values(RID_STR_COMMON_ATTRIBUTE_NUMBER_OF_LINES) 1961cdf0e10cSrcweir End If 1962cdf0e10cSrcweirFinalExit: 1963cdf0e10cSrcweir Exit Sub 1964cdf0e10cSrcweir 1965cdf0e10cSrcweirHandleErrors: 1966cdf0e10cSrcweir WriteDebug currentFunctionName & _ 1967cdf0e10cSrcweir " : issueKey " & issueKey & ": " & _ 1968cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 1969cdf0e10cSrcweir Resume FinalExit 1970cdf0e10cSrcweirEnd Sub 1971cdf0e10cSrcweir 1972cdf0e10cSrcweirSub AddIssueAndOneToDict(key As String) 1973cdf0e10cSrcweir On Error GoTo HandleErrors 1974cdf0e10cSrcweir Dim currentFunctionName As String 1975cdf0e10cSrcweir currentFunctionName = "AddIssueAndOneToDict" 1976cdf0e10cSrcweir 1977cdf0e10cSrcweir If mIssuesDict.Exists(key) Then 1978cdf0e10cSrcweir mIssuesDict.item(key) = mIssuesDict.item(key) + 1 1979cdf0e10cSrcweir Else 1980cdf0e10cSrcweir mIssuesDict.Add key, 1 1981cdf0e10cSrcweir End If 1982cdf0e10cSrcweirFinalExit: 1983cdf0e10cSrcweir Exit Sub 1984cdf0e10cSrcweir 1985cdf0e10cSrcweirHandleErrors: 1986cdf0e10cSrcweir WriteDebug currentFunctionName & " : key " & key & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1987cdf0e10cSrcweir Resume FinalExit 1988cdf0e10cSrcweirEnd Sub 1989cdf0e10cSrcweir 1990cdf0e10cSrcweirSub AddPreparedIssueAndOneToDict(key As String) 1991cdf0e10cSrcweir On Error GoTo HandleErrors 1992cdf0e10cSrcweir Dim currentFunctionName As String 1993cdf0e10cSrcweir currentFunctionName = "AddPreparedIssueAndOneToDict" 1994cdf0e10cSrcweir 1995cdf0e10cSrcweir If mPreparedIssuesDict.Exists(key) Then 1996cdf0e10cSrcweir mPreparedIssuesDict.item(key) = mPreparedIssuesDict.item(key) + 1 1997cdf0e10cSrcweir Else 1998cdf0e10cSrcweir mPreparedIssuesDict.Add key, 1 1999cdf0e10cSrcweir End If 2000cdf0e10cSrcweirFinalExit: 2001cdf0e10cSrcweir Exit Sub 2002cdf0e10cSrcweir 2003cdf0e10cSrcweirHandleErrors: 2004cdf0e10cSrcweir WriteDebug currentFunctionName & " : key " & key & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2005cdf0e10cSrcweir Resume FinalExit 2006cdf0e10cSrcweirEnd Sub 2007cdf0e10cSrcweir 2008cdf0e10cSrcweirFunction GetExcelInstance() As Excel.Application 2009cdf0e10cSrcweir On Error GoTo HandleErrors 2010cdf0e10cSrcweir Dim currentFunctionName As String 2011cdf0e10cSrcweir currentFunctionName = "GetExcelInstance" 2012cdf0e10cSrcweir 2013cdf0e10cSrcweir Dim xl As Excel.Application 2014cdf0e10cSrcweir On Error Resume Next 2015cdf0e10cSrcweir 'Try and get an existing instance 2016cdf0e10cSrcweir Set xl = GetObject(, "Excel.Application") 2017cdf0e10cSrcweir If Err.Number = 429 Then 2018cdf0e10cSrcweir Set xl = CreateObject("Excel.Application") 2019cdf0e10cSrcweir ElseIf Err.Number <> 0 Then 2020cdf0e10cSrcweir Set xl = Nothing 2021cdf0e10cSrcweir MsgBox "Error: " & Err.Description 2022cdf0e10cSrcweir Exit Function 2023cdf0e10cSrcweir End If 2024cdf0e10cSrcweir Set GetExcelInstance = xl 2025cdf0e10cSrcweir Set xl = Nothing 2026cdf0e10cSrcweirFinalExit: 2027cdf0e10cSrcweir Exit Function 2028cdf0e10cSrcweir 2029cdf0e10cSrcweirHandleErrors: 2030cdf0e10cSrcweir WriteDebug currentFunctionName & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2031cdf0e10cSrcweir Resume FinalExit 2032cdf0e10cSrcweirEnd Function 2033cdf0e10cSrcweir 2034cdf0e10cSrcweirSub WriteOverview(logWb As WorkBook, DocCount As DocumentCount, templateCount As DocumentCount, _ 2035cdf0e10cSrcweir macroClasses As DocMacroClassifications, issueClasses As DocIssueClassifications) 2036cdf0e10cSrcweir Const COV_ISSUECLASS_COMPLEX = "MAW_ISSUECLASS_COMPLEX" 2037cdf0e10cSrcweir Const COV_ISSUECLASS_MINOR = "MAW_ISSUECLASS_MINOR" 2038cdf0e10cSrcweir Const COV_ISSUECLASS_NONE = "MAW_ISSUECLASS_NONE" 2039cdf0e10cSrcweir 2040cdf0e10cSrcweir Const COV_MACROCLASS_COMPLEX = "MAW_MACROCLASS_COMPLEX" 2041cdf0e10cSrcweir Const COV_MACROCLASS_MEDIUM = "MAW_MACROCLASS_MEDIUM" 2042cdf0e10cSrcweir Const COV_MACROCLASS_SIMPLE = "MAW_MACROCLASS_SIMPLE" 2043cdf0e10cSrcweir Const COV_MACROCLASS_NONE = "MAW_MACROCLASS_NONE" 2044cdf0e10cSrcweir 2045cdf0e10cSrcweir Const COV_ISSUECOUNT_COMPLEX = "MAW_ISSUECOUNT_COMPLEX" 2046cdf0e10cSrcweir Const COV_ISSUECOUNT_MINOR = "MAW_ISSUECOUNT_MINOR" 2047cdf0e10cSrcweir 2048cdf0e10cSrcweir Const COV_MODDATES_LESS3MONTHS = "MAW_MODDATES_LESS3MONTHS" 2049cdf0e10cSrcweir Const COV_MODDATES_3TO6MONTHS = "MAW_MODDATES_3TO6MONTHS" 2050cdf0e10cSrcweir Const COV_MODDATES_6TO12MONTHS = "MAW_MODDATES_6TO12MONTHS" 2051cdf0e10cSrcweir Const COV_MODDATES_MORE12MONTHS = "MAW_MODDATES_MORE12MONTHS" 2052cdf0e10cSrcweir 2053cdf0e10cSrcweir Const COV_DOC_MIGRATION_COSTS = "Document_Migration_Costs" 2054cdf0e10cSrcweir Const COV_DOC_PREPARABLE_COSTS = "Document_Migration_Preparable_Costs" 2055cdf0e10cSrcweir Const COV_MACRO_MIGRATION_COSTS = "Macro_Migration_Costs" 2056cdf0e10cSrcweir 2057cdf0e10cSrcweir On Error GoTo HandleErrors 2058cdf0e10cSrcweir Dim currentFunctionName As String 2059cdf0e10cSrcweir currentFunctionName = "WriteOverview" 2060cdf0e10cSrcweir 2061cdf0e10cSrcweir Dim appName As String 2062cdf0e10cSrcweir appName = getAppSpecificApplicationName 2063cdf0e10cSrcweir 2064cdf0e10cSrcweir 'OV - Title 2065cdf0e10cSrcweir SetWorkbookNameValueToString logWb, COVERVIEW_TITLE_LABEL, GetTitle 2066cdf0e10cSrcweir SetWorkbookNameValueToVariant logWb, "AnalysisDate", Now 2067cdf0e10cSrcweir SetWorkbookNameValueToString logWb, "AnalysisVersion", _ 2068cdf0e10cSrcweir RID_STR_COMMON_OV_VERSION_STR & ": " & GetTitle & " " & GetVersion 2069cdf0e10cSrcweir 2070cdf0e10cSrcweir 'OV - Number of Documents Analyzed 2071cdf0e10cSrcweir AddLongToWorkbookNameValue logWb, CNUMBERDOC_ALL & getAppSpecificDocExt, DocCount.numDocsAnalyzed 2072cdf0e10cSrcweir AddLongToWorkbookNameValue logWb, CNUMBERDOC_ALL & getAppSpecificTemplateExt, templateCount.numDocsAnalyzed 2073cdf0e10cSrcweir 2074cdf0e10cSrcweir 'OV - Documents with Document Migration Issues (excludes macro issues) 2075cdf0e10cSrcweir AddLongToWorkbookNameValue logWb, appName & "_" & COV_ISSUECLASS_COMPLEX, issueClasses.complex 2076cdf0e10cSrcweir AddLongToWorkbookNameValue logWb, appName & "_" & COV_ISSUECLASS_MINOR, issueClasses.Minor 2077cdf0e10cSrcweir AddLongToWorkbookNameValue logWb, appName & "_" & COV_ISSUECLASS_NONE, issueClasses.None 2078cdf0e10cSrcweir 2079cdf0e10cSrcweir 'OV - Documents with Macro Migration Issues 2080cdf0e10cSrcweir AddLongToWorkbookNameValue logWb, appName & "_" & COV_MACROCLASS_COMPLEX, macroClasses.complex 2081cdf0e10cSrcweir AddLongToWorkbookNameValue logWb, appName & "_" & COV_MACROCLASS_MEDIUM, macroClasses.Medium 2082cdf0e10cSrcweir AddLongToWorkbookNameValue logWb, appName & "_" & COV_MACROCLASS_SIMPLE, macroClasses.Simple 2083cdf0e10cSrcweir AddLongToWorkbookNameValue logWb, appName & "_" & COV_MACROCLASS_NONE, macroClasses.None 2084cdf0e10cSrcweir 2085cdf0e10cSrcweir 'OV - Document Modification Dates 2086cdf0e10cSrcweir Dim modDates As DocModificationDates 2087cdf0e10cSrcweir Call GetDocModificationDates(modDates) 2088cdf0e10cSrcweir 2089cdf0e10cSrcweir SetWorkbookNameValueToLong logWb, COV_MODDATES_LESS3MONTHS, modDates.lessThanThreemonths 2090cdf0e10cSrcweir SetWorkbookNameValueToLong logWb, COV_MODDATES_3TO6MONTHS, modDates.threeToSixmonths 2091cdf0e10cSrcweir SetWorkbookNameValueToLong logWb, COV_MODDATES_6TO12MONTHS, modDates.sixToTwelvemonths 2092cdf0e10cSrcweir SetWorkbookNameValueToLong logWb, COV_MODDATES_MORE12MONTHS, modDates.greaterThanOneYear 2093cdf0e10cSrcweir 2094cdf0e10cSrcweir 2095cdf0e10cSrcweir If InDocPreparation Then 2096cdf0e10cSrcweir 'OV - Document Migration Issues(excludes macro issues) 2097cdf0e10cSrcweir AddLongToWorkbookNameValue logWb, appName & "_" & COV_ISSUECOUNT_COMPLEX, _ 2098cdf0e10cSrcweir DocCount.numComplexIssues + templateCount.numComplexIssues 2099cdf0e10cSrcweir AddLongToWorkbookNameValue logWb, appName & "_" & COV_ISSUECOUNT_MINOR, _ 2100cdf0e10cSrcweir DocCount.numMinorIssues + templateCount.numMinorIssues 2101cdf0e10cSrcweir 2102cdf0e10cSrcweir 'OV - Document Migration Costs 2103cdf0e10cSrcweir AddLongToWorkbookNameValue logWb, appName & "_" & COV_DOC_MIGRATION_COSTS, _ 2104cdf0e10cSrcweir DocCount.totalDocIssuesCosts + templateCount.totalDocIssuesCosts 2105cdf0e10cSrcweir 2106cdf0e10cSrcweir 'OV - Document Migration Preparable Costs 2107cdf0e10cSrcweir AddLongToWorkbookNameValue logWb, COV_DOC_PREPARABLE_COSTS, _ 2108cdf0e10cSrcweir DocCount.totalPreparableIssuesCosts + templateCount.totalPreparableIssuesCosts 2109cdf0e10cSrcweir 2110cdf0e10cSrcweir 'OV - Macro Migration Costs 2111cdf0e10cSrcweir AddLongToWorkbookNameValue logWb, appName & "_" & COV_MACRO_MIGRATION_COSTS, _ 2112cdf0e10cSrcweir DocCount.totalMacroCosts + templateCount.totalMacroCosts 2113cdf0e10cSrcweir End If 2114cdf0e10cSrcweir 2115cdf0e10cSrcweir 'OV - Internal Attributes 2116cdf0e10cSrcweir AddLongToWorkbookNameValue logWb, appName & "_" & "TotalDocsAnalysedWithIssues", _ 2117cdf0e10cSrcweir DocCount.numDocsAnalyzedWithIssues + templateCount.numDocsAnalyzedWithIssues 2118cdf0e10cSrcweir 2119cdf0e10cSrcweirFinalExit: 2120cdf0e10cSrcweir Exit Sub 2121cdf0e10cSrcweir 2122cdf0e10cSrcweirHandleErrors: 2123cdf0e10cSrcweir WriteDebug currentFunctionName & " : Problem writing overview: " & Err.Number & " " & Err.Description & " " & Err.Source 2124cdf0e10cSrcweir Resume FinalExit 2125cdf0e10cSrcweirEnd Sub 2126cdf0e10cSrcweir 2127cdf0e10cSrcweirSub SetupDAWResultsSpreadsheet(logWb As WorkBook, fontName As String, fontSize As Long) 2128cdf0e10cSrcweir On Error GoTo HandleErrors 2129cdf0e10cSrcweir Dim currentFunctionName As String 2130cdf0e10cSrcweir currentFunctionName = "SetupDAWResultsSpreadsheet" 2131cdf0e10cSrcweir Dim bSetupRun As Boolean 2132cdf0e10cSrcweir bSetupRun = CBool(GetWorkbookNameValueAsLong(logWb, COV_DAW_SETUP_SHEETS_RUN_LBL)) 2133cdf0e10cSrcweir 2134cdf0e10cSrcweir If bSetupRun Then Exit Sub 2135cdf0e10cSrcweir 2136cdf0e10cSrcweir 'Setup Text Boxes 2137cdf0e10cSrcweir SetupSheetTextBox logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_MOD_DATES_COMMENT_TXB, _ 2138cdf0e10cSrcweir RID_STR_COMMON_OV_DOC_MOD_DATES_COMMENT_TITLE, RID_STR_COMMON_OV_DOC_MOD_DATES_COMMENT_BODY, _ 2139cdf0e10cSrcweir CCOMMENTS_FONT_SIZE, fontName 2140cdf0e10cSrcweir SetupSheetTextBox logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_MOD_DATES_LEGEND_TXB, _ 2141cdf0e10cSrcweir RID_STR_COMMON_OV_LEGEND_TITLE, RID_STR_COMMON_OV_DOC_MOD_DATES_LEGEND_BODY, fontSize, fontName 2142cdf0e10cSrcweir SetupSheetTextBox logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_MACRO_COMMENT_TXB, _ 2143cdf0e10cSrcweir RID_STR_COMMON_OV_DOC_MACRO_COMMENT_TITLE, RID_STR_COMMON_OV_DOC_MACRO_COMMENT_BODY, _ 2144cdf0e10cSrcweir CCOMMENTS_FONT_SIZE, fontName 2145cdf0e10cSrcweir SetupSheetTextBox logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_MACRO_LEGEND_TXB, _ 2146cdf0e10cSrcweir RID_STR_COMMON_OV_LEGEND_TITLE, RID_STR_COMMON_OV_DOC_MACRO_LEGEND_BODY, fontSize, fontName 2147cdf0e10cSrcweir Dim monthLimit As Long 2148cdf0e10cSrcweir monthLimit = GetIssuesLimitInDays / CNUMDAYS_IN_MONTH 2149cdf0e10cSrcweir SetWorkbookNameValueToString logWb, COV_HIGH_LEVEL_ANALYSIS_LBL, _ 2150cdf0e10cSrcweir IIf(monthLimit <> CMAX_LIMIT, _ 2151cdf0e10cSrcweir ReplaceTopicTokens(RID_STR_COMMON_OV_HIGH_LEVEL_ANALYSIS_DAW, CR_TOPIC, CStr(monthLimit)), _ 2152cdf0e10cSrcweir RID_STR_COMMON_OV_HIGH_LEVEL_ANALYSIS_PAW_NO_LIMIT) 2153cdf0e10cSrcweir 2154cdf0e10cSrcweir SetupSheetTextBox logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_ANALYSIS_COMMENT_TXB, _ 2155cdf0e10cSrcweir RID_STR_COMMON_OV_DOC_ANALYSIS_COMMENT_TITLE, RID_STR_COMMON_OV_DOC_ANALYSIS_COMMENT_BODY, _ 2156cdf0e10cSrcweir CCOMMENTS_FONT_SIZE, fontName 2157cdf0e10cSrcweir SetupSheetTextBox logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_ANALYSIS_LEGEND_DAW_TXB, _ 2158cdf0e10cSrcweir RID_STR_COMMON_OV_LEGEND_TITLE, RID_STR_COMMON_OV_DOC_ANALYSIS_DAW_LEGEND_BODY, fontSize, fontName 2159cdf0e10cSrcweir 2160cdf0e10cSrcweir 'Setup Chart Titles 2161cdf0e10cSrcweir SetupSheetChartTitles logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_MOD_DATES_CHART, _ 2162cdf0e10cSrcweir RID_STR_COMMON_OV_DOC_MOD_DATES_CHART_TITLE 2163cdf0e10cSrcweir SetupSheetChartTitles logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_MACRO_CHART, _ 2164cdf0e10cSrcweir RID_STR_COMMON_OV_DOC_MACRO_CHART_TITLE 2165cdf0e10cSrcweir SetupSheetChartTitles logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_ANALYSIS_CHART, _ 2166cdf0e10cSrcweir RID_STR_COMMON_OV_DOC_ANALYSIS_CHART_TITLE 2167cdf0e10cSrcweir 2168cdf0e10cSrcweir 'Set selection to top cell of Overview 2169cdf0e10cSrcweir logWb.Sheets(RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW).Range("A1").Select 2170cdf0e10cSrcweir 2171cdf0e10cSrcweir bSetupRun = True 2172cdf0e10cSrcweir SetWorkbookNameValueToBoolean logWb, COV_DAW_SETUP_SHEETS_RUN_LBL, bSetupRun 2173cdf0e10cSrcweirFinalExit: 2174cdf0e10cSrcweir Exit Sub 2175cdf0e10cSrcweir 2176cdf0e10cSrcweirHandleErrors: 2177cdf0e10cSrcweir WriteDebug currentFunctionName & " : Problem setting up spreadsheet for DAW: " & Err.Number & " " & Err.Description & " " & Err.Source 2178cdf0e10cSrcweir Resume FinalExit 2179cdf0e10cSrcweirEnd Sub 2180cdf0e10cSrcweir 2181cdf0e10cSrcweirSub SetupPAWResultsSpreadsheet(logWb As WorkBook, fontName As String, fontSize As Long) 2182cdf0e10cSrcweir On Error GoTo HandleErrors 2183cdf0e10cSrcweir Dim currentFunctionName As String 2184cdf0e10cSrcweir currentFunctionName = "SetupPAWResultsSpreadsheet" 2185cdf0e10cSrcweir Dim bSetupRun As Boolean 2186cdf0e10cSrcweir bSetupRun = CBool(GetWorkbookNameValueAsLong(logWb, COV_PAW_SETUP_SHEETS_RUN_LBL)) 2187cdf0e10cSrcweir 2188cdf0e10cSrcweir If bSetupRun Then Exit Sub 2189cdf0e10cSrcweir 2190cdf0e10cSrcweir 'Costs 2191cdf0e10cSrcweir logWb.Names(COV_COSTS_PREPISSUE_COUNT_COL_LBL).RefersToRange.EntireColumn.Hidden = False 2192cdf0e10cSrcweir 2193cdf0e10cSrcweir 'Setup Text Boxes 2194cdf0e10cSrcweir SetupSheetTextBox logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_MOD_DATES_LEGEND_TXB, _ 2195cdf0e10cSrcweir RID_STR_COMMON_OV_LEGEND_TITLE, RID_STR_COMMON_OV_DOC_MOD_DATES_LEGEND_BODY, fontSize, fontName 2196cdf0e10cSrcweir SetupSheetTextBox logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_MACRO_LEGEND_TXB, _ 2197cdf0e10cSrcweir RID_STR_COMMON_OV_LEGEND_TITLE, RID_STR_COMMON_OV_DOC_MACRO_LEGEND_BODY, fontSize, fontName 2198cdf0e10cSrcweir SetWorkbookNameValueToString logWb, COV_HIGH_LEVEL_ANALYSIS_LBL, _ 2199cdf0e10cSrcweir RID_STR_COMMON_OV_HIGH_LEVEL_ANALYSIS_PAW_NO_LIMIT 2200cdf0e10cSrcweir SetupSheetTextBox logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_ANALYSIS_LEGEND_PAW_TXB, _ 2201cdf0e10cSrcweir RID_STR_COMMON_OV_LEGEND_TITLE, RID_STR_COMMON_OV_DOC_ANALYSIS_PAW_LEGEND_BODY, fontSize, fontName 2202cdf0e10cSrcweir 2203cdf0e10cSrcweir 'Setup Chart Titles 2204cdf0e10cSrcweir SetupSheetChartTitles logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_MOD_DATES_CHART, _ 2205cdf0e10cSrcweir RID_STR_COMMON_OV_DOC_MOD_DATES_CHART_TITLE 2206cdf0e10cSrcweir SetupSheetChartTitles logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_MACRO_CHART, _ 2207cdf0e10cSrcweir RID_STR_COMMON_OV_DOC_MACRO_CHART_TITLE 2208cdf0e10cSrcweir SetupSheetChartTitles logWb, RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW, COV_DOC_ANALYSIS_CHART, _ 2209cdf0e10cSrcweir RID_STR_COMMON_OV_DOC_ANALYSIS_CHART_TITLE 2210cdf0e10cSrcweir 2211cdf0e10cSrcweir 'Set selection to top cell of Overview 2212cdf0e10cSrcweir logWb.Sheets(RID_STR_COMMON_RESULTS_SHEET_NAME_OVERVIEW).Range("A1").Select 2213cdf0e10cSrcweir 2214cdf0e10cSrcweir bSetupRun = True 2215cdf0e10cSrcweir SetWorkbookNameValueToBoolean logWb, COV_PAW_SETUP_SHEETS_RUN_LBL, bSetupRun 2216cdf0e10cSrcweir 2217cdf0e10cSrcweirFinalExit: 2218cdf0e10cSrcweir Exit Sub 2219cdf0e10cSrcweir 2220cdf0e10cSrcweirHandleErrors: 2221cdf0e10cSrcweir WriteDebug currentFunctionName & " : Problem setting up spreadsheet for PAW: " & Err.Number & " " & Err.Description & " " & Err.Source 2222cdf0e10cSrcweir Resume FinalExit 2223cdf0e10cSrcweirEnd Sub 2224cdf0e10cSrcweir 2225cdf0e10cSrcweirSub SetupPrintRanges(logWb As WorkBook, docPropRow As Long, appIssuesRow As Long, issueDetailsRow As Long, _ 2226cdf0e10cSrcweir refDetailsRow As Long) 2227cdf0e10cSrcweir On Error GoTo HandleErrors 2228cdf0e10cSrcweir Dim currentFunctionName As String 2229cdf0e10cSrcweir currentFunctionName = "SetupPrintRanges" 2230cdf0e10cSrcweir 2231cdf0e10cSrcweir 'Set Print Ranges 2232cdf0e10cSrcweir If InDocPreparation Then 2233cdf0e10cSrcweir 2234cdf0e10cSrcweir logWb.Worksheets(RID_STR_COMMON_RESULTS_SHEET_NAME_DOCPROP).PageSetup.PrintArea = "$A1:$U" & (docPropRow + mDocPropRowOffset) 2235cdf0e10cSrcweir logWb.Worksheets(RID_STR_COMMON_RESULTS_SHEET_NAME_DOCISSUE_DETAILS).PageSetup.PrintArea = "$A1:$J" & issueDetailsRow 2236cdf0e10cSrcweir logWb.Worksheets(RID_STR_COMMON_RESULTS_SHEET_NAME_DOCREF_DETAILS).PageSetup.PrintArea = "$A1:$G" & refDetailsRow 2237cdf0e10cSrcweir If getAppSpecificApplicationName = CAPPNAME_WORD Then 2238cdf0e10cSrcweir logWb.Worksheets(RID_STR_COMMON_RESULTS_SHEET_NAME_DOCISSUES_WORD).PageSetup.PrintArea = _ 2239cdf0e10cSrcweir "$A1:$N" & appIssuesRow 2240cdf0e10cSrcweir ElseIf getAppSpecificApplicationName = CAPPNAME_EXCEL Then 2241cdf0e10cSrcweir logWb.Worksheets(RID_STR_COMMON_RESULTS_SHEET_NAME_DOCISSUES_EXCEL).PageSetup.PrintArea = _ 2242cdf0e10cSrcweir "$A1:$M" & appIssuesRow 2243cdf0e10cSrcweir Else 2244cdf0e10cSrcweir logWb.Worksheets(RID_STR_COMMON_RESULTS_SHEET_NAME_DOCISSUES_POWERPOINT).PageSetup.PrintArea = _ 2245cdf0e10cSrcweir "$A1:$K" & appIssuesRow 2246cdf0e10cSrcweir End If 2247cdf0e10cSrcweir Else 2248cdf0e10cSrcweir logWb.Worksheets(RID_STR_COMMON_RESULTS_SHEET_NAME_DOCPROP).PageSetup.PrintArea = "$A1:$U" & (docPropRow + mDocPropRowOffset) 2249cdf0e10cSrcweir End If 2250cdf0e10cSrcweir 2251cdf0e10cSrcweirFinalExit: 2252cdf0e10cSrcweir Exit Sub 2253cdf0e10cSrcweir 2254cdf0e10cSrcweirHandleErrors: 2255cdf0e10cSrcweir WriteDebug currentFunctionName & " : Problem setting print ranges: " & Err.Number & " " & Err.Description & " " & Err.Source 2256cdf0e10cSrcweir Resume FinalExit 2257cdf0e10cSrcweirEnd Sub 2258cdf0e10cSrcweir 2259cdf0e10cSrcweirSub SetupSheetChartTitles(logWb As WorkBook, namedWorksheet As String, namedChart As String, _ 2260cdf0e10cSrcweir chartTitle As String) 2261cdf0e10cSrcweir Const CCHART_TITLE_FONT_SIZE = 11 2262cdf0e10cSrcweir On Error GoTo HandleErrors 2263cdf0e10cSrcweir Dim currentFunctionName As String 2264cdf0e10cSrcweir currentFunctionName = "SetupSheetChartTitles" 2265cdf0e10cSrcweir 2266cdf0e10cSrcweir With logWb.Sheets(namedWorksheet).ChartObjects(namedChart).Chart 2267cdf0e10cSrcweir .HasTitle = True 2268cdf0e10cSrcweir .chartTitle.Characters.Text = chartTitle 2269cdf0e10cSrcweir .chartTitle.Font.Size = CCHART_TITLE_FONT_SIZE 2270cdf0e10cSrcweir End With 2271cdf0e10cSrcweir 2272cdf0e10cSrcweirFinalExit: 2273cdf0e10cSrcweir Exit Sub 2274cdf0e10cSrcweir 2275cdf0e10cSrcweirHandleErrors: 2276cdf0e10cSrcweir WriteDebug currentFunctionName & _ 2277cdf0e10cSrcweir " namedWorkSheet: " & namedWorksheet & _ 2278cdf0e10cSrcweir " namedChart: " & namedChart & _ 2279cdf0e10cSrcweir " chartTitle: " & chartTitle & _ 2280cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 2281cdf0e10cSrcweir Resume FinalExit 2282cdf0e10cSrcweirEnd Sub 2283cdf0e10cSrcweir 2284cdf0e10cSrcweirSub SetupSheetTextBox(logWb As WorkBook, namedWorksheet As String, _ 2285cdf0e10cSrcweir textBoxName As String, textBoxTitle As String, textBoxBody As String, _ 2286cdf0e10cSrcweir textSize As Long, fontName As String) 2287cdf0e10cSrcweir 2288cdf0e10cSrcweir Const CMAX_INSERTABLE_STRING_LEN = 255 2289cdf0e10cSrcweir On Error GoTo HandleErrors 2290cdf0e10cSrcweir Dim currentFunctionName As String 2291cdf0e10cSrcweir currentFunctionName = "SetupSheetTextBox" 2292cdf0e10cSrcweir 2293cdf0e10cSrcweir Dim strTextBody As String 2294cdf0e10cSrcweir Dim allText As String 2295cdf0e10cSrcweir strTextBody = ReplaceTopic2Tokens(textBoxBody, CR_STR, Chr(10), CR_PRODUCT, RID_STR_COMMON_OV_PRODUCT_STR) 2296cdf0e10cSrcweir 2297cdf0e10cSrcweir 'Setup Text Boxes 2298cdf0e10cSrcweir logWb.Sheets(namedWorksheet).Activate 2299cdf0e10cSrcweir logWb.Sheets(namedWorksheet).Shapes(textBoxName).Select 2300cdf0e10cSrcweir 2301cdf0e10cSrcweir '*** Workaround Excel bug: 213841 XL: Passed Strings Longer Than 255 Characters Are Truncated 2302cdf0e10cSrcweir Dim I As Long 2303cdf0e10cSrcweir logWb.Application.Selection.Text = "" 2304cdf0e10cSrcweir 2305cdf0e10cSrcweir logWb.Application.Selection.Characters.Text = textBoxTitle & Chr(10) 2306cdf0e10cSrcweir 2307cdf0e10cSrcweir With logWb.Application.Selection 2308cdf0e10cSrcweir For I = 0 To Int(Len(strTextBody) / CMAX_INSERTABLE_STRING_LEN) 2309cdf0e10cSrcweir .Characters(.Characters.count + 1).Text = Mid(strTextBody, _ 2310cdf0e10cSrcweir (I * CMAX_INSERTABLE_STRING_LEN) + 1, CMAX_INSERTABLE_STRING_LEN) 2311cdf0e10cSrcweir Next 2312cdf0e10cSrcweir End With 2313cdf0e10cSrcweir 2314cdf0e10cSrcweir 'Highlight title only 2315cdf0e10cSrcweir With logWb.Application.Selection.Characters(start:=1, Length:=Len(textBoxTitle)).Font 2316cdf0e10cSrcweir .name = fontName 2317cdf0e10cSrcweir .FontStyle = "Bold" 2318cdf0e10cSrcweir .Size = textSize 2319cdf0e10cSrcweir End With 2320cdf0e10cSrcweir With logWb.Application.Selection.Characters(start:=Len(textBoxTitle) + 1, _ 2321cdf0e10cSrcweir Length:=Len(strTextBody) + 1).Font 2322cdf0e10cSrcweir .name = fontName 2323cdf0e10cSrcweir .FontStyle = "Regular" 2324cdf0e10cSrcweir .Size = textSize 2325cdf0e10cSrcweir End With 2326cdf0e10cSrcweir 2327cdf0e10cSrcweirFinalExit: 2328cdf0e10cSrcweir Exit Sub 2329cdf0e10cSrcweir 2330cdf0e10cSrcweirHandleErrors: 2331cdf0e10cSrcweir WriteDebug currentFunctionName & _ 2332cdf0e10cSrcweir " namedWorkSheet: " & namedWorksheet & _ 2333cdf0e10cSrcweir " textBoxName: " & textBoxName & _ 2334cdf0e10cSrcweir " textBoxTitle: " & textBoxTitle & _ 2335cdf0e10cSrcweir " textBoxBody: " & textBoxBody & _ 2336cdf0e10cSrcweir " textSize: " & textSize & _ 2337cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 2338cdf0e10cSrcweir Resume FinalExit 2339cdf0e10cSrcweirEnd Sub 2340cdf0e10cSrcweirFunction GetWorkbookNameValueAsLong(logWb As WorkBook, name As String) As Long 2341cdf0e10cSrcweir On Error GoTo HandleErrors 2342cdf0e10cSrcweir Dim currentFunctionName As String 2343cdf0e10cSrcweir currentFunctionName = "GetWorkbookNameValueAsLong" 2344cdf0e10cSrcweir 2345cdf0e10cSrcweir GetWorkbookNameValueAsLong = logWb.Names(name).RefersToRange.Cells(1, 1).value 2346cdf0e10cSrcweir 2347cdf0e10cSrcweirFinalExit: 2348cdf0e10cSrcweir Exit Function 2349cdf0e10cSrcweir 2350cdf0e10cSrcweirHandleErrors: 2351cdf0e10cSrcweir GetWorkbookNameValueAsLong = 0 2352cdf0e10cSrcweir WriteDebug currentFunctionName & " : name " & name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2353cdf0e10cSrcweir Resume FinalExit 2354cdf0e10cSrcweirEnd Function 2355cdf0e10cSrcweir 2356cdf0e10cSrcweirFunction GetWorksheetCellValueAsLong(logWs As Worksheet, row As Long, col As Long) As Long 2357cdf0e10cSrcweir On Error GoTo HandleErrors 2358cdf0e10cSrcweir Dim currentFunctionName As String 2359cdf0e10cSrcweir currentFunctionName = "GetWorksheetCellValueAsLong" 2360cdf0e10cSrcweir 2361cdf0e10cSrcweir GetWorksheetCellValueAsLong = logWs.Cells(row, col).value 2362cdf0e10cSrcweir 2363cdf0e10cSrcweirFinalExit: 2364cdf0e10cSrcweir Exit Function 2365cdf0e10cSrcweir 2366cdf0e10cSrcweirHandleErrors: 2367cdf0e10cSrcweir WriteDebug currentFunctionName & _ 2368cdf0e10cSrcweir " : row " & row & _ 2369cdf0e10cSrcweir " : col " & col & _ 2370cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 2371cdf0e10cSrcweir Resume FinalExit 2372cdf0e10cSrcweirEnd Function 2373cdf0e10cSrcweir 2374cdf0e10cSrcweirFunction GetWorksheetCellValueAsString(logWs As Worksheet, row As Long, col As Long) As String 2375cdf0e10cSrcweir On Error GoTo HandleErrors 2376cdf0e10cSrcweir Dim currentFunctionName As String 2377cdf0e10cSrcweir currentFunctionName = "GetWorksheetCellValueToString" 2378cdf0e10cSrcweir 2379cdf0e10cSrcweir GetWorksheetCellValueAsString = logWs.Cells(row, col).value 2380cdf0e10cSrcweir 2381cdf0e10cSrcweirFinalExit: 2382cdf0e10cSrcweir Exit Function 2383cdf0e10cSrcweir 2384cdf0e10cSrcweirHandleErrors: 2385cdf0e10cSrcweir GetWorksheetCellValueAsString = "" 2386cdf0e10cSrcweir 2387cdf0e10cSrcweir WriteDebug currentFunctionName & _ 2388cdf0e10cSrcweir " : row " & row & _ 2389cdf0e10cSrcweir " : col " & col & _ 2390cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 2391cdf0e10cSrcweir Resume FinalExit 2392cdf0e10cSrcweirEnd Function 2393cdf0e10cSrcweir 2394cdf0e10cSrcweirSub SetWorksheetCellValueToLong(logWs As Worksheet, row As Long, col As Long, val As Long) 2395cdf0e10cSrcweir On Error GoTo HandleErrors 2396cdf0e10cSrcweir Dim currentFunctionName As String 2397cdf0e10cSrcweir currentFunctionName = "SetWorksheetCellValueToLong" 2398cdf0e10cSrcweir 2399cdf0e10cSrcweir logWs.Cells(row, col) = val 2400cdf0e10cSrcweir 2401cdf0e10cSrcweirFinalExit: 2402cdf0e10cSrcweir Exit Sub 2403cdf0e10cSrcweir 2404cdf0e10cSrcweirHandleErrors: 2405cdf0e10cSrcweir WriteDebug currentFunctionName & _ 2406cdf0e10cSrcweir " : row " & row & _ 2407cdf0e10cSrcweir " : col " & col & _ 2408cdf0e10cSrcweir " : val " & val & ": " & _ 2409cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 2410cdf0e10cSrcweir Resume FinalExit 2411cdf0e10cSrcweirEnd Sub 2412cdf0e10cSrcweirSub SetWorksheetCellValueToInteger(logWs As Worksheet, row As Long, col As Long, intVal As Integer) 2413cdf0e10cSrcweir On Error GoTo HandleErrors 2414cdf0e10cSrcweir Dim currentFunctionName As String 2415cdf0e10cSrcweir currentFunctionName = "SetWorksheetCellValueToInteger" 2416cdf0e10cSrcweir 2417cdf0e10cSrcweir logWs.Cells(row, col) = intVal 2418cdf0e10cSrcweir 2419cdf0e10cSrcweirFinalExit: 2420cdf0e10cSrcweir Exit Sub 2421cdf0e10cSrcweir 2422cdf0e10cSrcweirHandleErrors: 2423cdf0e10cSrcweir WriteDebug currentFunctionName & _ 2424cdf0e10cSrcweir " : row " & row & _ 2425cdf0e10cSrcweir " : col " & col & _ 2426cdf0e10cSrcweir " : intVal " & intVal & ": " & _ 2427cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 2428cdf0e10cSrcweir Resume FinalExit 2429cdf0e10cSrcweirEnd Sub 2430cdf0e10cSrcweir 2431cdf0e10cSrcweirSub SetWorksheetCellValueToVariant(logWs As Worksheet, row As Long, col As Long, varVal As Variant) 2432cdf0e10cSrcweir On Error GoTo HandleErrors 2433cdf0e10cSrcweir Dim currentFunctionName As String 2434cdf0e10cSrcweir currentFunctionName = "SetWorksheetCellValueToInteger" 2435cdf0e10cSrcweir 2436cdf0e10cSrcweir logWs.Cells(row, col) = varVal 2437cdf0e10cSrcweir 2438cdf0e10cSrcweirFinalExit: 2439cdf0e10cSrcweir Exit Sub 2440cdf0e10cSrcweir 2441cdf0e10cSrcweirHandleErrors: 2442cdf0e10cSrcweir WriteDebug currentFunctionName & _ 2443cdf0e10cSrcweir " : row " & row & _ 2444cdf0e10cSrcweir " : col " & col & _ 2445cdf0e10cSrcweir " : varVal " & varVal & ": " & _ 2446cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 2447cdf0e10cSrcweir Resume FinalExit 2448cdf0e10cSrcweirEnd Sub 2449cdf0e10cSrcweir 2450cdf0e10cSrcweirSub SetWorksheetCellValueToString(logWs As Worksheet, row As Long, col As Long, strVal As String) 2451cdf0e10cSrcweir On Error GoTo HandleErrors 2452cdf0e10cSrcweir Dim currentFunctionName As String 2453cdf0e10cSrcweir currentFunctionName = "SetWorksheetCellValueToString" 2454cdf0e10cSrcweir 2455cdf0e10cSrcweir logWs.Cells(row, col) = strVal 2456cdf0e10cSrcweir 2457cdf0e10cSrcweirFinalExit: 2458cdf0e10cSrcweir Exit Sub 2459cdf0e10cSrcweir 2460cdf0e10cSrcweirHandleErrors: 2461cdf0e10cSrcweir WriteDebug currentFunctionName & _ 2462cdf0e10cSrcweir " : row " & row & _ 2463cdf0e10cSrcweir " : col " & col & _ 2464cdf0e10cSrcweir " : strVal " & strVal & ": " & _ 2465cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 2466cdf0e10cSrcweir Resume FinalExit 2467cdf0e10cSrcweirEnd Sub 2468cdf0e10cSrcweir 2469cdf0e10cSrcweirSub SetWorkbookNameValueToBoolean(logWb As WorkBook, name As String, bVal As Boolean) 2470cdf0e10cSrcweir On Error GoTo HandleErrors 2471cdf0e10cSrcweir Dim currentFunctionName As String 2472cdf0e10cSrcweir currentFunctionName = "SetWorkbookNameValueToBoolean" 2473cdf0e10cSrcweir 2474cdf0e10cSrcweir logWb.Names(name).RefersToRange.Cells(1, 1) = bVal 2475cdf0e10cSrcweir 2476cdf0e10cSrcweirFinalExit: 2477cdf0e10cSrcweir Exit Sub 2478cdf0e10cSrcweir 2479cdf0e10cSrcweirHandleErrors: 2480cdf0e10cSrcweir WriteDebug currentFunctionName & " : name " & name & " : boolean value " & bVal & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2481cdf0e10cSrcweir Resume FinalExit 2482cdf0e10cSrcweirEnd Sub 2483cdf0e10cSrcweir 2484cdf0e10cSrcweirSub SetWorkbookNameValueToString(logWb As WorkBook, name As String, val As String) 2485cdf0e10cSrcweir On Error GoTo HandleErrors 2486cdf0e10cSrcweir Dim currentFunctionName As String 2487cdf0e10cSrcweir currentFunctionName = "SetWorkbookNameValueToString" 2488cdf0e10cSrcweir 2489cdf0e10cSrcweir logWb.Names(name).RefersToRange.Cells(1, 1) = val 2490cdf0e10cSrcweir 2491cdf0e10cSrcweirFinalExit: 2492cdf0e10cSrcweir Exit Sub 2493cdf0e10cSrcweir 2494cdf0e10cSrcweirHandleErrors: 2495cdf0e10cSrcweir WriteDebug currentFunctionName & " : name " & name & " : value " & val & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2496cdf0e10cSrcweir Resume FinalExit 2497cdf0e10cSrcweirEnd Sub 2498cdf0e10cSrcweir 2499cdf0e10cSrcweirSub SetWorkbookNameValueToLong(logWb As WorkBook, name As String, val As Long) 2500cdf0e10cSrcweir On Error GoTo HandleErrors 2501cdf0e10cSrcweir Dim currentFunctionName As String 2502cdf0e10cSrcweir currentFunctionName = "SetWorkbookNameValueToLong" 2503cdf0e10cSrcweir 2504cdf0e10cSrcweir logWb.Names(name).RefersToRange.Cells(1, 1) = val 2505cdf0e10cSrcweir 2506cdf0e10cSrcweirFinalExit: 2507cdf0e10cSrcweir Exit Sub 2508cdf0e10cSrcweir 2509cdf0e10cSrcweirHandleErrors: 2510cdf0e10cSrcweir WriteDebug currentFunctionName & " : name " & name & " : value " & val & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2511cdf0e10cSrcweir Resume FinalExit 2512cdf0e10cSrcweirEnd Sub 2513cdf0e10cSrcweir 2514cdf0e10cSrcweirSub SetWorkbookNameValueToVariant(logWb As WorkBook, name As String, val As Variant) 2515cdf0e10cSrcweir On Error GoTo HandleErrors 2516cdf0e10cSrcweir Dim currentFunctionName As String 2517cdf0e10cSrcweir currentFunctionName = "SetWorkbookNameValueToVariant" 2518cdf0e10cSrcweir 2519cdf0e10cSrcweir logWb.Names(name).RefersToRange.Cells(1, 1) = val 2520cdf0e10cSrcweir 2521cdf0e10cSrcweirFinalExit: 2522cdf0e10cSrcweir Exit Sub 2523cdf0e10cSrcweir 2524cdf0e10cSrcweirHandleErrors: 2525cdf0e10cSrcweir WriteDebug currentFunctionName & " : name " & name & " : value " & val & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2526cdf0e10cSrcweir Resume FinalExit 2527cdf0e10cSrcweirEnd Sub 2528cdf0e10cSrcweir 2529cdf0e10cSrcweirSub AddLongToWorkbookNameValue(logWb As WorkBook, name As String, val As Long) 2530cdf0e10cSrcweir On Error GoTo HandleErrors 2531cdf0e10cSrcweir Dim currentFunctionName As String 2532cdf0e10cSrcweir currentFunctionName = "AddLongToWorkbookNameValue" 2533cdf0e10cSrcweir 2534cdf0e10cSrcweir logWb.Names(name).RefersToRange.Cells(1, 1) = logWb.Names(name).RefersToRange.Cells(1, 1).value + val 2535cdf0e10cSrcweir 2536cdf0e10cSrcweirFinalExit: 2537cdf0e10cSrcweir Exit Sub 2538cdf0e10cSrcweir 2539cdf0e10cSrcweirHandleErrors: 2540cdf0e10cSrcweir WriteDebug currentFunctionName & " : name " & name & " : value " & val & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2541cdf0e10cSrcweir Resume FinalExit 2542cdf0e10cSrcweirEnd Sub 2543cdf0e10cSrcweirSub AddVariantToWorkbookNameValue(logWb As WorkBook, name As String, varVal As Variant) 2544cdf0e10cSrcweir On Error GoTo HandleErrors 2545cdf0e10cSrcweir Dim currentFunctionName As String 2546cdf0e10cSrcweir currentFunctionName = "AddVariantToWorkbookNameValue" 2547cdf0e10cSrcweir 2548cdf0e10cSrcweir logWb.Names(name).RefersToRange.Cells(1, 1) = logWb.Names(name).RefersToRange.Cells(1, 1).value + varVal 2549cdf0e10cSrcweir 2550cdf0e10cSrcweirFinalExit: 2551cdf0e10cSrcweir Exit Sub 2552cdf0e10cSrcweir 2553cdf0e10cSrcweirHandleErrors: 2554cdf0e10cSrcweir WriteDebug currentFunctionName & " : name " & name & " : value " & varVal & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2555cdf0e10cSrcweir Resume FinalExit 2556cdf0e10cSrcweirEnd Sub 2557cdf0e10cSrcweir 2558cdf0e10cSrcweirSub SaveAnalysisResultsVariables(logWb As WorkBook, offsetDocIssueDetailsRow As Long, _ 2559cdf0e10cSrcweir offsetDocRefDetailsRow As Long) 2560cdf0e10cSrcweir On Error GoTo HandleErrors 2561cdf0e10cSrcweir Dim currentFunctionName As String 2562cdf0e10cSrcweir currentFunctionName = "SaveAnalysisResultsVariables" 2563cdf0e10cSrcweir 2564cdf0e10cSrcweir 'OV - Internal Attributes 2565cdf0e10cSrcweir SetWorkbookNameValueToLong logWb, "TotalIssuesAnalysed", offsetDocIssueDetailsRow 2566cdf0e10cSrcweir SetWorkbookNameValueToLong logWb, "TotalRefsAnalysed", offsetDocRefDetailsRow 2567cdf0e10cSrcweirFinalExit: 2568cdf0e10cSrcweir Exit Sub 2569cdf0e10cSrcweir 2570cdf0e10cSrcweirHandleErrors: 2571cdf0e10cSrcweir WriteDebug currentFunctionName & " : offsetDocIssueDetailsRow " & offsetDocIssueDetailsRow & _ 2572cdf0e10cSrcweir " : offsetDocRefDetailsRow " & offsetDocRefDetailsRow & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2573cdf0e10cSrcweir Resume FinalExit 2574cdf0e10cSrcweirEnd Sub 2575cdf0e10cSrcweir 2576cdf0e10cSrcweirSub SetupAnalysisResultsVariables(logWb As WorkBook, _ 2577cdf0e10cSrcweir offsetDocPropRow As Long, offsetDocIssuesRow As Long, _ 2578cdf0e10cSrcweir offsetDocIssueDetailsRow As Long, offsetDocRefDetailsRow As Long) 2579cdf0e10cSrcweir On Error GoTo HandleErrors 2580cdf0e10cSrcweir Dim currentFunctionName As String 2581cdf0e10cSrcweir currentFunctionName = "SetupAnalysisResultsVariables" 2582cdf0e10cSrcweir 2583cdf0e10cSrcweir offsetDocPropRow = GetWorkbookNameValueAsLong(logWb, CTOTAL_DOCS_ANALYZED) 2584cdf0e10cSrcweir offsetDocIssueDetailsRow = GetWorkbookNameValueAsLong(logWb, "TotalIssuesAnalysed") 2585cdf0e10cSrcweir offsetDocRefDetailsRow = GetWorkbookNameValueAsLong(logWb, "TotalRefsAnalysed") 2586cdf0e10cSrcweir offsetDocIssuesRow = GetWorkbookNameValueAsLong(logWb, getAppSpecificApplicationName & "_" & "TotalDocsAnalysedWithIssues") 2587cdf0e10cSrcweirFinalExit: 2588cdf0e10cSrcweir Exit Sub 2589cdf0e10cSrcweir 2590cdf0e10cSrcweirHandleErrors: 2591cdf0e10cSrcweir WriteDebug currentFunctionName & _ 2592cdf0e10cSrcweir " : offsetDocPropRow " & offsetDocPropRow & _ 2593cdf0e10cSrcweir " : offsetDocIssueDetailsRow " & offsetDocIssueDetailsRow & _ 2594cdf0e10cSrcweir " : offsetDocRefDetailsRow " & offsetDocRefDetailsRow & _ 2595cdf0e10cSrcweir " : offsetDocIssuesRow " & offsetDocIssuesRow & _ 2596cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 2597cdf0e10cSrcweir Resume FinalExit 2598cdf0e10cSrcweirEnd Sub 2599cdf0e10cSrcweir 2600cdf0e10cSrcweirSub WriteToIni(key As String, value As String) 2601cdf0e10cSrcweir On Error GoTo HandleErrors 2602cdf0e10cSrcweir Dim currentFunctionName As String 2603cdf0e10cSrcweir currentFunctionName = "WriteToIni" 2604cdf0e10cSrcweir 2605cdf0e10cSrcweir If mIniFilePath = "" Then Exit Sub 2606cdf0e10cSrcweir 2607cdf0e10cSrcweir Call WritePrivateProfileString("Analysis", key, value, mIniFilePath) 2608cdf0e10cSrcweirFinalExit: 2609cdf0e10cSrcweir Exit Sub 2610cdf0e10cSrcweir 2611cdf0e10cSrcweirHandleErrors: 2612cdf0e10cSrcweir WriteDebug currentFunctionName & " : key " & key & " : value " & value & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2613cdf0e10cSrcweir Resume FinalExit 2614cdf0e10cSrcweirEnd Sub 2615cdf0e10cSrcweir 2616cdf0e10cSrcweirSub WriteToLog(key As String, value As String) 2617cdf0e10cSrcweir On Error GoTo HandleErrors 2618cdf0e10cSrcweir Dim currentFunctionName As String 2619cdf0e10cSrcweir currentFunctionName = "WriteToLog" 2620cdf0e10cSrcweir 2621cdf0e10cSrcweir If mLogFilePath = "" Then Exit Sub 2622cdf0e10cSrcweir 2623cdf0e10cSrcweir Dim sSection As String 2624cdf0e10cSrcweir sSection = getAppSpecificApplicationName 2625cdf0e10cSrcweir 2626cdf0e10cSrcweir Call WritePrivateProfileString(sSection, key, value, mLogFilePath) 2627cdf0e10cSrcweirFinalExit: 2628cdf0e10cSrcweir Exit Sub 2629cdf0e10cSrcweir 2630cdf0e10cSrcweirHandleErrors: 2631cdf0e10cSrcweir WriteDebug currentFunctionName & " : key " & key & " : value " & value & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2632cdf0e10cSrcweir Resume FinalExit 2633cdf0e10cSrcweirEnd Sub 2634cdf0e10cSrcweirSub WriteDebug(value As String) 2635cdf0e10cSrcweir On Error Resume Next 'Ignore errors in our error writing routines - could get circular dependency otherwise 2636cdf0e10cSrcweir Static ErrCount As Long 2637cdf0e10cSrcweir 2638cdf0e10cSrcweir If mLogFilePath = "" Then Exit Sub 2639cdf0e10cSrcweir 2640cdf0e10cSrcweir Dim sSection As String 2641cdf0e10cSrcweir sSection = getAppSpecificApplicationName & "Debug" 2642cdf0e10cSrcweir 2643cdf0e10cSrcweir If mDebugLevel > 0 Then 2644cdf0e10cSrcweir Call WritePrivateProfileString(sSection, "Doc" & mDocIndex & "_debug" & ErrCount, value, mLogFilePath) 2645cdf0e10cSrcweir ErrCount = ErrCount + 1 2646cdf0e10cSrcweir Else 2647cdf0e10cSrcweir Debug.Print 2648cdf0e10cSrcweir End If 2649cdf0e10cSrcweirEnd Sub 2650cdf0e10cSrcweirSub WriteDebugLevelTwo(value As String) 2651cdf0e10cSrcweir On Error Resume Next 'Ignore errors in our error writing routines - could get circular dependency otherwise 2652cdf0e10cSrcweir Static ErrCountTwo As Long 2653cdf0e10cSrcweir 2654cdf0e10cSrcweir If mLogFilePath = "" Then Exit Sub 2655cdf0e10cSrcweir 2656cdf0e10cSrcweir Dim sSection As String 2657cdf0e10cSrcweir sSection = getAppSpecificApplicationName & "Debug" 2658cdf0e10cSrcweir 2659cdf0e10cSrcweir If mDebugLevel > 1 Then 2660cdf0e10cSrcweir Call WritePrivateProfileString(sSection, "Doc" & mDocIndex & "_debug" & ErrCountTwo, "Level2: " & value, mLogFilePath) 2661cdf0e10cSrcweir ErrCountTwo = ErrCountTwo + 1 2662cdf0e10cSrcweir Else 2663cdf0e10cSrcweir Debug.Print 2664cdf0e10cSrcweir End If 2665cdf0e10cSrcweirEnd Sub 2666cdf0e10cSrcweir 2667cdf0e10cSrcweirPublic Function ProfileLoadDict(dict As Scripting.Dictionary, _ 2668cdf0e10cSrcweir lpSectionName As String, _ 2669cdf0e10cSrcweir inifile As String) As Long 2670cdf0e10cSrcweir On Error GoTo HandleErrors 2671cdf0e10cSrcweir Dim currentFunctionName As String 2672cdf0e10cSrcweir currentFunctionName = "ProfileLoadDict" 2673cdf0e10cSrcweir Dim success As Long 2674cdf0e10cSrcweir Dim c As Long 2675cdf0e10cSrcweir Dim nSize As Long 2676cdf0e10cSrcweir Dim KeyData As String 2677cdf0e10cSrcweir Dim lpKeyName As String 2678cdf0e10cSrcweir Dim ret As String 2679cdf0e10cSrcweir 2680cdf0e10cSrcweir ret = Space$(2048) 2681cdf0e10cSrcweir nSize = Len(ret) 2682cdf0e10cSrcweir success = GetPrivateProfileString( _ 2683cdf0e10cSrcweir lpSectionName, vbNullString, "", ret, nSize, inifile) 2684cdf0e10cSrcweir 2685cdf0e10cSrcweir If success Then 2686cdf0e10cSrcweir ret = Left$(ret, success) 2687cdf0e10cSrcweir 2688cdf0e10cSrcweir Do Until ret = "" 2689cdf0e10cSrcweir lpKeyName = StripNulls(ret) 2690cdf0e10cSrcweir KeyData = ProfileGetItem( _ 2691cdf0e10cSrcweir lpSectionName, lpKeyName, "", inifile) 2692cdf0e10cSrcweir dict.Add lpKeyName, KeyData 2693cdf0e10cSrcweir Loop 2694cdf0e10cSrcweir End If 2695cdf0e10cSrcweir ProfileLoadDict = dict.count 2696cdf0e10cSrcweirFinalExit: 2697cdf0e10cSrcweir Exit Function 2698cdf0e10cSrcweir 2699cdf0e10cSrcweirHandleErrors: 2700cdf0e10cSrcweir WriteDebug currentFunctionName & _ 2701cdf0e10cSrcweir " : dict.Count " & dict.count & _ 2702cdf0e10cSrcweir " : lpSectionName " & lpSectionName & _ 2703cdf0e10cSrcweir " : inifile " & inifile & _ 2704cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 2705cdf0e10cSrcweir Resume FinalExit 2706cdf0e10cSrcweirEnd Function 2707cdf0e10cSrcweirPrivate Function StripNulls(startStrg As String) As String 2708cdf0e10cSrcweir On Error GoTo HandleErrors 2709cdf0e10cSrcweir Dim currentFunctionName As String 2710cdf0e10cSrcweir currentFunctionName = "StripNulls" 2711cdf0e10cSrcweir Dim pos As Long 2712cdf0e10cSrcweir Dim item As String 2713cdf0e10cSrcweir 2714cdf0e10cSrcweir pos = InStr(1, startStrg, Chr$(0)) 2715cdf0e10cSrcweir 2716cdf0e10cSrcweir If pos Then 2717cdf0e10cSrcweir 2718cdf0e10cSrcweir item = Mid$(startStrg, 1, pos - 1) 2719cdf0e10cSrcweir startStrg = Mid$(startStrg, pos + 1, Len(startStrg)) 2720cdf0e10cSrcweir StripNulls = item 2721cdf0e10cSrcweir 2722cdf0e10cSrcweir End If 2723cdf0e10cSrcweir 2724cdf0e10cSrcweirFinalExit: 2725cdf0e10cSrcweir Exit Function 2726cdf0e10cSrcweir 2727cdf0e10cSrcweirHandleErrors: 2728cdf0e10cSrcweir WriteDebug currentFunctionName & " : startStrg " & startStrg & " : " & Err.Number & " " & Err.Description & " " & Err.Source 2729cdf0e10cSrcweir Resume FinalExit 2730cdf0e10cSrcweirEnd Function 2731cdf0e10cSrcweir 2732cdf0e10cSrcweirPublic Function ProfileGetItem(lpSectionName As String, _ 2733cdf0e10cSrcweir lpKeyName As String, _ 2734cdf0e10cSrcweir defaultValue As String, _ 2735cdf0e10cSrcweir inifile As String) As String 2736cdf0e10cSrcweir On Error GoTo HandleErrors 2737cdf0e10cSrcweir Dim currentFunctionName As String 2738cdf0e10cSrcweir currentFunctionName = "ProfileGetItem" 2739cdf0e10cSrcweir 2740cdf0e10cSrcweir Dim success As Long 2741cdf0e10cSrcweir Dim nSize As Long 2742cdf0e10cSrcweir Dim ret As String 2743cdf0e10cSrcweir ret = Space$(2048) 2744cdf0e10cSrcweir nSize = Len(ret) 2745cdf0e10cSrcweir success = GetPrivateProfileString(lpSectionName, _ 2746cdf0e10cSrcweir lpKeyName, _ 2747cdf0e10cSrcweir defaultValue, _ 2748cdf0e10cSrcweir ret, _ 2749cdf0e10cSrcweir nSize, _ 2750cdf0e10cSrcweir inifile) 2751cdf0e10cSrcweir If success Then 2752cdf0e10cSrcweir ProfileGetItem = Left$(ret, success) 2753cdf0e10cSrcweir Else 2754cdf0e10cSrcweir ProfileGetItem = defaultValue 2755cdf0e10cSrcweir End If 2756cdf0e10cSrcweir 2757cdf0e10cSrcweirFinalExit: 2758cdf0e10cSrcweir Exit Function 2759cdf0e10cSrcweir 2760cdf0e10cSrcweirHandleErrors: 2761cdf0e10cSrcweir WriteDebug currentFunctionName & _ 2762cdf0e10cSrcweir " : lpSectionName " & lpSectionName & _ 2763cdf0e10cSrcweir " : lpKeyName " & lpKeyName & _ 2764cdf0e10cSrcweir " : defaultValue " & defaultValue & _ 2765cdf0e10cSrcweir " : inifile " & inifile & _ 2766cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 2767cdf0e10cSrcweir Resume FinalExit 2768cdf0e10cSrcweirEnd Function 2769cdf0e10cSrcweir 2770cdf0e10cSrcweirPublic Function GetDefaultPassword() As String 2771cdf0e10cSrcweir On Error GoTo HandleErrors 2772cdf0e10cSrcweir Dim currentFunctionName As String 2773cdf0e10cSrcweir currentFunctionName = "GetDefaultPassword" 2774cdf0e10cSrcweir 2775cdf0e10cSrcweir Static myPassword As String 2776cdf0e10cSrcweir 2777cdf0e10cSrcweir If myPassword = "" Then 2778cdf0e10cSrcweir myPassword = ProfileGetItem("Analysis", CDEFAULT_PASSWORD, "", mIniFilePath) 2779cdf0e10cSrcweir End If 2780cdf0e10cSrcweir 2781cdf0e10cSrcweir GetDefaultPassword = myPassword 2782cdf0e10cSrcweirFinalExit: 2783cdf0e10cSrcweir Exit Function 2784cdf0e10cSrcweir 2785cdf0e10cSrcweirHandleErrors: 2786cdf0e10cSrcweir WriteDebug currentFunctionName & Err.Number & " " & Err.Description & " " & Err.Source 2787cdf0e10cSrcweir Resume FinalExit 2788cdf0e10cSrcweirEnd Function 2789cdf0e10cSrcweir 2790cdf0e10cSrcweirPublic Function GetVersion() As String 2791cdf0e10cSrcweir On Error GoTo HandleErrors 2792cdf0e10cSrcweir Dim currentFunctionName As String 2793cdf0e10cSrcweir currentFunctionName = "GetVersion" 2794cdf0e10cSrcweir 2795cdf0e10cSrcweir Static myVersion As String 2796cdf0e10cSrcweir 2797cdf0e10cSrcweir If myVersion = "" Then 2798cdf0e10cSrcweir myVersion = ProfileGetItem("Analysis", CVERSION, "", mIniFilePath) 2799cdf0e10cSrcweir End If 2800cdf0e10cSrcweir 2801cdf0e10cSrcweir GetVersion = myVersion 2802cdf0e10cSrcweirFinalExit: 2803cdf0e10cSrcweir Exit Function 2804cdf0e10cSrcweir 2805cdf0e10cSrcweirHandleErrors: 2806cdf0e10cSrcweir WriteDebug currentFunctionName & Err.Number & " " & Err.Description & " " & Err.Source 2807cdf0e10cSrcweir Resume FinalExit 2808cdf0e10cSrcweirEnd Function 2809cdf0e10cSrcweirPublic Function GetTitle() As String 2810cdf0e10cSrcweir On Error GoTo HandleErrors 2811cdf0e10cSrcweir Dim currentFunctionName As String 2812cdf0e10cSrcweir currentFunctionName = "GetTitle" 2813cdf0e10cSrcweir 2814cdf0e10cSrcweir Static myTitle As String 2815cdf0e10cSrcweir 2816cdf0e10cSrcweir If myTitle = "" Then 2817cdf0e10cSrcweir myTitle = ProfileGetItem("Analysis", CTITLE, RID_STR_COMMON_ANALYSIS_STR, mIniFilePath) 2818cdf0e10cSrcweir End If 2819cdf0e10cSrcweir 2820cdf0e10cSrcweir GetTitle = myTitle 2821cdf0e10cSrcweirFinalExit: 2822cdf0e10cSrcweir Exit Function 2823cdf0e10cSrcweir 2824cdf0e10cSrcweirHandleErrors: 2825cdf0e10cSrcweir WriteDebug currentFunctionName & Err.Number & " " & Err.Description & " " & Err.Source 2826cdf0e10cSrcweir Resume FinalExit 2827cdf0e10cSrcweirEnd Function 2828cdf0e10cSrcweir 2829cdf0e10cSrcweirSub SetPrepareToNone() 2830cdf0e10cSrcweir On Error GoTo HandleErrors 2831cdf0e10cSrcweir Dim currentFunctionName As String 2832cdf0e10cSrcweir currentFunctionName = "SetPrepareToNone" 2833cdf0e10cSrcweir 2834cdf0e10cSrcweir Call WritePrivateProfileString("Analysis", CDOPREPARE, CStr(0), mIniFilePath) 2835cdf0e10cSrcweir 2836cdf0e10cSrcweirFinalExit: 2837cdf0e10cSrcweir Exit Sub 2838cdf0e10cSrcweir 2839cdf0e10cSrcweirHandleErrors: 2840cdf0e10cSrcweir WriteDebug currentFunctionName & Err.Number & " " & Err.Description & " " & Err.Source 2841cdf0e10cSrcweir Resume FinalExit 2842cdf0e10cSrcweirEnd Sub 2843cdf0e10cSrcweir 2844cdf0e10cSrcweirFunction CheckForAbort() As Boolean 2845cdf0e10cSrcweir Dim currentFunctionName As String 2846cdf0e10cSrcweir Dim bAbort As Boolean 2847cdf0e10cSrcweir 2848cdf0e10cSrcweir currentFunctionName = "CheckForAbort" 2849cdf0e10cSrcweir bAbort = False 2850cdf0e10cSrcweir 2851cdf0e10cSrcweir On Error GoTo HandleErrors 2852cdf0e10cSrcweir 2853cdf0e10cSrcweir bAbort = CBool(ProfileGetItem("Analysis", C_ABORT_ANALYSIS, "false", mIniFilePath)) 2854cdf0e10cSrcweir 2855cdf0e10cSrcweir 'reset the flag 2856cdf0e10cSrcweir If (bAbort) Then Call WriteToIni(C_ABORT_ANALYSIS, "false") 2857cdf0e10cSrcweir 2858cdf0e10cSrcweirFinalExit: 2859cdf0e10cSrcweir CheckForAbort = bAbort 2860cdf0e10cSrcweir Exit Function 2861cdf0e10cSrcweir 2862cdf0e10cSrcweirHandleErrors: 2863cdf0e10cSrcweir WriteDebug currentFunctionName & Err.Number & " " & Err.Description & " " & Err.Source 2864cdf0e10cSrcweir Resume FinalExit 2865cdf0e10cSrcweirEnd Function 2866cdf0e10cSrcweir 2867cdf0e10cSrcweirFunction CheckDoPrepare() As Boolean 2868cdf0e10cSrcweir On Error GoTo HandleErrors 2869cdf0e10cSrcweir Dim currentFunctionName As String 2870cdf0e10cSrcweir currentFunctionName = "CheckDoPrepare" 2871cdf0e10cSrcweir 2872cdf0e10cSrcweir Static bDoPrepare As Boolean 2873cdf0e10cSrcweir Static myDoPrepare As String 2874cdf0e10cSrcweir 2875cdf0e10cSrcweir If myDoPrepare = "" Then 2876cdf0e10cSrcweir bDoPrepare = CBool(ProfileGetItem("Analysis", _ 2877cdf0e10cSrcweir CDOPREPARE, "False", mIniFilePath)) 2878cdf0e10cSrcweir myDoPrepare = "OK" 2879cdf0e10cSrcweir End If 2880cdf0e10cSrcweir 2881cdf0e10cSrcweir CheckDoPrepare = bDoPrepare 2882cdf0e10cSrcweirFinalExit: 2883cdf0e10cSrcweir Exit Function 2884cdf0e10cSrcweir 2885cdf0e10cSrcweirHandleErrors: 2886cdf0e10cSrcweir WriteDebug currentFunctionName & Err.Number & " " & Err.Description & " " & Err.Source 2887cdf0e10cSrcweir Resume FinalExit 2888cdf0e10cSrcweirEnd Function 2889cdf0e10cSrcweir 2890cdf0e10cSrcweirFunction GetIssuesLimitInDays() As Long 2891cdf0e10cSrcweir On Error GoTo HandleErrors 2892cdf0e10cSrcweir Dim currentFunctionName As String 2893cdf0e10cSrcweir 2894cdf0e10cSrcweir currentFunctionName = "GetIssuesLimitInDays" 2895cdf0e10cSrcweir 2896cdf0e10cSrcweir Static issuesLimit As Long 2897cdf0e10cSrcweir Static myDoPrepare As String 2898cdf0e10cSrcweir 2899cdf0e10cSrcweir If issuesLimit = 0 Then 2900cdf0e10cSrcweir issuesLimit = CLng(ProfileGetItem("Analysis", _ 2901cdf0e10cSrcweir CISSUES_LIMIT, CMAX_LIMIT, mIniFilePath)) * CNUMDAYS_IN_MONTH 2902cdf0e10cSrcweir End If 2903cdf0e10cSrcweir 2904cdf0e10cSrcweir GetIssuesLimitInDays = issuesLimit 2905cdf0e10cSrcweirFinalExit: 2906cdf0e10cSrcweir Exit Function 2907cdf0e10cSrcweir 2908cdf0e10cSrcweirHandleErrors: 2909cdf0e10cSrcweir WriteDebug currentFunctionName & Err.Number & " " & Err.Description & " " & Err.Source 2910cdf0e10cSrcweir Resume FinalExit 2911cdf0e10cSrcweirEnd Function 2912cdf0e10cSrcweir 2913cdf0e10cSrcweirPublic Sub AddIssueDetailsNote(myIssue As IssueInfo, noteNum As Long, noteStr As String, _ 2914cdf0e10cSrcweir Optional preStr As String) 2915cdf0e10cSrcweir On Error GoTo HandleErrors 2916cdf0e10cSrcweir Dim currentFunctionName As String 2917cdf0e10cSrcweir currentFunctionName = "AddIssueDetailsNote" 2918cdf0e10cSrcweir 2919cdf0e10cSrcweir If IsMissing(preStr) Then 2920cdf0e10cSrcweir preStr = RID_STR_COMMON_NOTE_PRE 2921cdf0e10cSrcweir End If 2922cdf0e10cSrcweir myIssue.Attributes.Add preStr & "[" & noteNum & "]" 2923cdf0e10cSrcweir myIssue.Values.Add noteStr 2924cdf0e10cSrcweir 2925cdf0e10cSrcweirFinalExit: 2926cdf0e10cSrcweir Exit Sub 2927cdf0e10cSrcweir 2928cdf0e10cSrcweirHandleErrors: 2929cdf0e10cSrcweir WriteDebug currentFunctionName & " : noteNum " & noteNum & " : noteStr " & noteStr & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2930cdf0e10cSrcweir Resume FinalExit 2931cdf0e10cSrcweirEnd Sub 2932cdf0e10cSrcweir 2933cdf0e10cSrcweirPublic Sub SetupWizardVariables( _ 2934cdf0e10cSrcweir fileList As String, storeToDir As String, resultsFile As String, _ 2935cdf0e10cSrcweir logFile As String, resultsTemplate As String, bOverwriteFile As Boolean, _ 2936cdf0e10cSrcweir bNewResultsFile As Boolean, statFileName As String, debugLevel As Long, _ 2937cdf0e10cSrcweir outputType As String, singleFile As String) 2938cdf0e10cSrcweir On Error GoTo HandleErrors 2939cdf0e10cSrcweir Dim currentFunctionName As String 2940cdf0e10cSrcweir currentFunctionName = "SetupWizardVariables" 2941cdf0e10cSrcweir 2942cdf0e10cSrcweir If mIniFilePath = "" Then 2943cdf0e10cSrcweir mIniFilePath = GetAppDataFolder & "\Sun\AnalysisWizard\" & CWIZARD & ".ini" 2944cdf0e10cSrcweir End If 2945cdf0e10cSrcweir 2946cdf0e10cSrcweir statFileName = ProfileGetItem("Analysis", CSTAT_FILE, "", mIniFilePath) 2947cdf0e10cSrcweir fileList = ProfileGetItem("Analysis", CFILE_LIST, "", mIniFilePath) 2948cdf0e10cSrcweir storeToDir = ProfileGetItem("Analysis", COUTPUT_DIR, "", mIniFilePath) 2949cdf0e10cSrcweir resultsFile = ProfileGetItem("Analysis", CRESULTS_FILE, "", mIniFilePath) 2950cdf0e10cSrcweir logFile = ProfileGetItem("Analysis", CLOG_FILE, "", mIniFilePath) 2951cdf0e10cSrcweir resultsTemplate = ProfileGetItem("Analysis", CRESULTS_TEMPLATE, "", mIniFilePath) 2952cdf0e10cSrcweir bOverwriteFile = IIf(ProfileGetItem("Analysis", CRESULTS_EXIST, COVERWRITE_FILE, mIniFilePath) = COVERWRITE_FILE, _ 2953cdf0e10cSrcweir True, False) 2954cdf0e10cSrcweir bNewResultsFile = CBool(ProfileGetItem("Analysis", CNEW_RESULTS_FILE, "True", mIniFilePath)) 2955cdf0e10cSrcweir debugLevel = CLng(ProfileGetItem("Analysis", CDEBUG_LEVEL, "1", mIniFilePath)) 2956cdf0e10cSrcweir outputType = ProfileGetItem("Analysis", COUTPUT_TYPE, COUTPUT_TYPE_XLS, mIniFilePath) 2957cdf0e10cSrcweir singleFile = ProfileGetItem("Analysis", CSINGLE_FILE, "", mIniFilePath) 2958cdf0e10cSrcweirFinalExit: 2959cdf0e10cSrcweir Exit Sub 2960cdf0e10cSrcweir 2961cdf0e10cSrcweirHandleErrors: 2962cdf0e10cSrcweir WriteDebug currentFunctionName & _ 2963cdf0e10cSrcweir ": mIniFilePath " & mIniFilePath & ": " & _ 2964cdf0e10cSrcweir Err.Number & " " & Err.Description & " " & Err.Source 2965cdf0e10cSrcweir Resume FinalExit 2966cdf0e10cSrcweirEnd Sub 2967cdf0e10cSrcweir 2968cdf0e10cSrcweirPublic Sub SetupSearchTypes(searchTypes As Collection) 2969cdf0e10cSrcweir On Error GoTo HandleErrors 2970cdf0e10cSrcweir Dim currentFunctionName As String 2971cdf0e10cSrcweir currentFunctionName = "SetupSearchTypes" 2972cdf0e10cSrcweir 2973cdf0e10cSrcweir Dim bDocument As Boolean 2974cdf0e10cSrcweir Dim bTemplate As Boolean 2975cdf0e10cSrcweir 2976cdf0e10cSrcweir bDocument = CBool(ProfileGetItem("Analysis", LCase("type" & getAppSpecificApplicationName & "doc"), "False", mIniFilePath)) 2977cdf0e10cSrcweir bTemplate = CBool(ProfileGetItem("Analysis", LCase("type" & getAppSpecificApplicationName & "dot"), "False", mIniFilePath)) 2978cdf0e10cSrcweir If bDocument = True Then searchTypes.Add "*" & getAppSpecificDocExt 2979cdf0e10cSrcweir If bTemplate = True Then searchTypes.Add "*" & getAppSpecificTemplateExt 2980cdf0e10cSrcweirFinalExit: 2981cdf0e10cSrcweir Exit Sub 2982cdf0e10cSrcweir 2983cdf0e10cSrcweirHandleErrors: 2984cdf0e10cSrcweir WriteDebug currentFunctionName & ": searchTypes.Count " & searchTypes.count & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2985cdf0e10cSrcweir Resume FinalExit 2986cdf0e10cSrcweirEnd Sub 2987cdf0e10cSrcweir 2988cdf0e10cSrcweirSub WriteXMLHeader(out As TextStream) 2989cdf0e10cSrcweir On Error GoTo HandleErrors 2990cdf0e10cSrcweir Dim currentFunctionName As String 2991cdf0e10cSrcweir currentFunctionName = "WriteXMLHeader" 2992cdf0e10cSrcweir 2993cdf0e10cSrcweir out.WriteLine "<?xml version=""1.0"" encoding=""ISO-8859-1""?>" 2994cdf0e10cSrcweir out.WriteLine "<!DOCTYPE results SYSTEM 'analysis.dtd'>" 2995cdf0e10cSrcweir 2996cdf0e10cSrcweirFinalExit: 2997cdf0e10cSrcweir Exit Sub 2998cdf0e10cSrcweir 2999cdf0e10cSrcweirHandleErrors: 3000cdf0e10cSrcweir WriteDebug currentFunctionName & ": " & Err.Number & " " & Err.Description & " " & Err.Source 3001cdf0e10cSrcweir Resume FinalExit 3002cdf0e10cSrcweirEnd Sub 3003cdf0e10cSrcweirSub WriteXMLResultsStartTag(out As TextStream) 3004cdf0e10cSrcweir On Error GoTo HandleErrors 3005cdf0e10cSrcweir Dim currentFunctionName As String 3006cdf0e10cSrcweir currentFunctionName = "WriteXMLResultsStartTag" 3007cdf0e10cSrcweir 3008cdf0e10cSrcweir out.WriteLine "<results generated-by=""" & IIf(InDocPreparation, "documentanalysis_preparation", "documentanalysis") & """" 3009cdf0e10cSrcweir out.WriteLine " version=""" & GetVersion & """ timestamp=""" & Now & """" 3010cdf0e10cSrcweir out.WriteLine " type=""" & getAppSpecificApplicationName & """ >" 3011cdf0e10cSrcweir 3012cdf0e10cSrcweirFinalExit: 3013cdf0e10cSrcweir Exit Sub 3014cdf0e10cSrcweir 3015cdf0e10cSrcweirHandleErrors: 3016cdf0e10cSrcweir WriteDebug currentFunctionName & ": " & Err.Number & " " & Err.Description & " " & Err.Source 3017cdf0e10cSrcweir Resume FinalExit 3018cdf0e10cSrcweirEnd Sub 3019cdf0e10cSrcweirSub WriteXMLResultsEndTag(out As TextStream) 3020cdf0e10cSrcweir On Error GoTo HandleErrors 3021cdf0e10cSrcweir Dim currentFunctionName As String 3022cdf0e10cSrcweir currentFunctionName = "WriteXMLResultsEndTag" 3023cdf0e10cSrcweir 3024cdf0e10cSrcweir out.WriteLine "</results>" 3025cdf0e10cSrcweir 3026cdf0e10cSrcweirFinalExit: 3027cdf0e10cSrcweir Exit Sub 3028cdf0e10cSrcweir 3029cdf0e10cSrcweirHandleErrors: 3030cdf0e10cSrcweir WriteDebug currentFunctionName & ": " & Err.Number & " " & Err.Description & " " & Err.Source 3031cdf0e10cSrcweir Resume FinalExit 3032cdf0e10cSrcweirEnd Sub 3033cdf0e10cSrcweir 3034cdf0e10cSrcweirSub WriteXMLDocProperties(out As TextStream, aAnalysis As DocumentAnalysis) 3035cdf0e10cSrcweir On Error GoTo HandleErrors 3036cdf0e10cSrcweir Dim currentFunctionName As String 3037cdf0e10cSrcweir currentFunctionName = "WriteXMLDocProperties" 3038cdf0e10cSrcweir 3039cdf0e10cSrcweir out.WriteLine "<document location=""" & EncodeXML(aAnalysis.name) & """" 3040cdf0e10cSrcweir out.WriteLine " application=""" & aAnalysis.Application & """" 3041cdf0e10cSrcweir out.WriteLine " issues-count=""" & (aAnalysis.IssuesCount) & """" 3042cdf0e10cSrcweir out.WriteLine " pages=""" & aAnalysis.PageCount & """" 3043cdf0e10cSrcweir out.WriteLine " created=""" & CheckDate(aAnalysis.Created) & """" 3044cdf0e10cSrcweir out.WriteLine " modified=""" & CheckDate(aAnalysis.Modified) & """" 3045cdf0e10cSrcweir out.WriteLine " accessed=""" & CheckDate(aAnalysis.Accessed) & """" 3046cdf0e10cSrcweir out.WriteLine " printed=""" & CheckDate(aAnalysis.Printed) & """" 3047cdf0e10cSrcweir out.WriteLine " last-save-by=""" & aAnalysis.SavedBy & """" 3048cdf0e10cSrcweir out.WriteLine " revision=""" & aAnalysis.Revision & """" 3049cdf0e10cSrcweir out.WriteLine " based-on-template=""" & EncodeXML(aAnalysis.Template) & """" 3050cdf0e10cSrcweir out.WriteLine ">" 3051cdf0e10cSrcweir 3052cdf0e10cSrcweirFinalExit: 3053cdf0e10cSrcweir Exit Sub 3054cdf0e10cSrcweir 3055cdf0e10cSrcweirHandleErrors: 3056cdf0e10cSrcweir WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 3057cdf0e10cSrcweir Resume FinalExit 3058cdf0e10cSrcweirEnd Sub 3059cdf0e10cSrcweir 3060cdf0e10cSrcweirSub WriteXMLDocPropertiesEndTag(out As TextStream) 3061cdf0e10cSrcweir On Error GoTo HandleErrors 3062cdf0e10cSrcweir Dim currentFunctionName As String 3063cdf0e10cSrcweir currentFunctionName = "WriteXMLDocPropertiesEndTag" 3064cdf0e10cSrcweir 3065cdf0e10cSrcweir out.WriteLine "</document>" 3066cdf0e10cSrcweir 3067cdf0e10cSrcweirFinalExit: 3068cdf0e10cSrcweir Exit Sub 3069cdf0e10cSrcweir 3070cdf0e10cSrcweirHandleErrors: 3071cdf0e10cSrcweir WriteDebug currentFunctionName & ": " & Err.Number & " " & Err.Description & " " & Err.Source 3072cdf0e10cSrcweir Resume FinalExit 3073cdf0e10cSrcweirEnd Sub 3074cdf0e10cSrcweir 3075cdf0e10cSrcweirSub WriteXMLDocRefDetails(out As TextStream, aAnalysis As DocumentAnalysis) 3076cdf0e10cSrcweir On Error GoTo HandleErrors 3077cdf0e10cSrcweir Dim currentFunctionName As String 3078cdf0e10cSrcweir currentFunctionName = "WriteXMLDocRefDetails" 3079cdf0e10cSrcweir Dim myIssue As IssueInfo 3080cdf0e10cSrcweir 3081cdf0e10cSrcweir 'Output References for Docs with Macros 3082cdf0e10cSrcweir If aAnalysis.HasMacros And (aAnalysis.References.count > 0) Then 3083cdf0e10cSrcweir out.WriteLine "<references>" 3084cdf0e10cSrcweir For Each myIssue In aAnalysis.References 3085cdf0e10cSrcweir OutputXMLReferenceAttributes out, aAnalysis, myIssue 3086cdf0e10cSrcweir Next myIssue 3087cdf0e10cSrcweir out.WriteLine "</references>" 3088cdf0e10cSrcweir End If 3089cdf0e10cSrcweir 3090cdf0e10cSrcweirFinalExit: 3091cdf0e10cSrcweir Exit Sub 3092cdf0e10cSrcweir 3093cdf0e10cSrcweirHandleErrors: 3094cdf0e10cSrcweir WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 3095cdf0e10cSrcweir Resume FinalExit 3096cdf0e10cSrcweirEnd Sub 3097cdf0e10cSrcweir 3098cdf0e10cSrcweirSub OutputXMLReferenceAttributes(out As TextStream, aAnalysis As DocumentAnalysis, myIssue As IssueInfo) 3099cdf0e10cSrcweir On Error GoTo HandleErrors 3100cdf0e10cSrcweir Dim currentFunctionName As String 3101cdf0e10cSrcweir currentFunctionName = "OutputXMLReferenceAttributes" 3102cdf0e10cSrcweir Dim strAttributes As String 3103cdf0e10cSrcweir 3104cdf0e10cSrcweir With myIssue 3105cdf0e10cSrcweir out.WriteLine "<reference" 3106cdf0e10cSrcweir 3107cdf0e10cSrcweir strAttributes = .Values("Major") & "." & .Values("Minor") 3108cdf0e10cSrcweir strAttributes = IIf(strAttributes = "0.0" Or strAttributes = ".", .Values("Name"), _ 3109cdf0e10cSrcweir .Values("Name") & " " & .Values("Major") & "." & .Values("Minor")) 3110cdf0e10cSrcweir out.WriteLine " name=""" & EncodeXML(strAttributes) & """" 3111cdf0e10cSrcweir 3112cdf0e10cSrcweir If .Values("Type") = "Project" Then 3113cdf0e10cSrcweir strAttributes = "Project reference" 3114cdf0e10cSrcweir Else 3115cdf0e10cSrcweir strAttributes = IIf(.Values("Description") <> "", .Values("Description"), RID_STR_COMMON_NA) 3116cdf0e10cSrcweir End If 3117cdf0e10cSrcweir out.WriteLine " description=""" & EncodeXML(strAttributes) & """" 3118cdf0e10cSrcweir If .Values("IsBroken") <> RID_STR_COMMON_ATTRIBUTE_BROKEN Then 3119cdf0e10cSrcweir out.WriteLine " location=""" & .Values("File") & """" 3120cdf0e10cSrcweir End If 3121cdf0e10cSrcweir out.WriteLine " type=""" & .Values("Type") & """" 3122cdf0e10cSrcweir strAttributes = IIf(.Values("GUID") <> "", .Values("GUID"), RID_STR_COMMON_NA) 3123cdf0e10cSrcweir out.WriteLine " GUID=""" & strAttributes & """" 3124cdf0e10cSrcweir out.WriteLine " is-broken=""" & .Values("IsBroken") & """" 3125cdf0e10cSrcweir out.WriteLine " builtin=""" & .Values("BuiltIn") & """" 3126cdf0e10cSrcweir 3127cdf0e10cSrcweir out.WriteLine " />" 3128cdf0e10cSrcweir End With 3129cdf0e10cSrcweir 3130cdf0e10cSrcweirFinalExit: 3131cdf0e10cSrcweir Exit Sub 3132cdf0e10cSrcweir 3133cdf0e10cSrcweirHandleErrors: 3134cdf0e10cSrcweir WriteDebug currentFunctionName & " : path " & aAnalysis.name & " : myIssue " & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML & ": " & Err.Number & " " & Err.Description & " " & Err.Source 3135cdf0e10cSrcweir Resume FinalExit 3136cdf0e10cSrcweirEnd Sub 3137cdf0e10cSrcweir 3138cdf0e10cSrcweirSub WriteXMLDocIssueDetails(out As TextStream, aAnalysis As DocumentAnalysis) 3139cdf0e10cSrcweir On Error GoTo HandleErrors 3140cdf0e10cSrcweir Dim currentFunctionName As String 3141cdf0e10cSrcweir currentFunctionName = "WriteXMLDocIssueDetails" 3142cdf0e10cSrcweir 3143cdf0e10cSrcweir Dim myIssue As IssueInfo 3144cdf0e10cSrcweir 3145cdf0e10cSrcweir If aAnalysis.Issues.count = 0 Then Exit Sub 3146cdf0e10cSrcweir 3147cdf0e10cSrcweir out.WriteLine "<issues>" 3148cdf0e10cSrcweir For Each myIssue In aAnalysis.Issues 3149cdf0e10cSrcweir OutputXMLCommonIssueDetails out, aAnalysis, myIssue 3150cdf0e10cSrcweir OutputXMLCommonIssueAttributes out, myIssue 3151cdf0e10cSrcweir out.WriteLine "</issue>" 3152cdf0e10cSrcweir Next myIssue 3153cdf0e10cSrcweir out.WriteLine "</issues>" 3154cdf0e10cSrcweir 3155cdf0e10cSrcweirFinalExit: 3156cdf0e10cSrcweir Exit Sub 3157cdf0e10cSrcweir 3158cdf0e10cSrcweirHandleErrors: 3159cdf0e10cSrcweir WriteDebug currentFunctionName & " : path " & aAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 3160cdf0e10cSrcweir Resume FinalExit 3161cdf0e10cSrcweirEnd Sub 3162cdf0e10cSrcweir 3163cdf0e10cSrcweirSub OutputXMLCommonIssueDetails(out As TextStream, aAnalysis As DocumentAnalysis, myIssue As IssueInfo) 3164cdf0e10cSrcweir On Error GoTo HandleErrors 3165cdf0e10cSrcweir Dim currentFunctionName As String 3166cdf0e10cSrcweir currentFunctionName = "OutputXMLCommonIssueDetails" 3167cdf0e10cSrcweir 3168cdf0e10cSrcweir out.WriteLine "<issue category=""" & myIssue.IssueTypeXML & """" 3169cdf0e10cSrcweir out.WriteLine " type=""" & myIssue.SubTypeXML & """" 3170cdf0e10cSrcweir 3171cdf0e10cSrcweir 'NOTE: Dropping severity - now stored in results.xlt, do not want to open it to fetch this data 3172cdf0e10cSrcweir 'out.WriteLine " severity=""" & IIf(CheckForMinorIssue(aAnalysis, myIssue), "Minor", "Major") & """" 3173cdf0e10cSrcweir out.WriteLine " prepared=""" & IIf((myIssue.Preparable), "True", "False") & """ >" 3174cdf0e10cSrcweir 3175cdf0e10cSrcweir out.WriteLine "<location type=""" & myIssue.locationXML & """ >" 3176cdf0e10cSrcweir 3177cdf0e10cSrcweir If myIssue.SubLocation <> "" Then 3178cdf0e10cSrcweir out.WriteLine "<property name=""sublocation"" value=""" & myIssue.SubLocation & """ />" 3179cdf0e10cSrcweir End If 3180cdf0e10cSrcweir If myIssue.Line <> -1 Then 3181cdf0e10cSrcweir out.WriteLine "<property name=""line"" value=""" & myIssue.Line & """ />" 3182cdf0e10cSrcweir End If 3183cdf0e10cSrcweir If myIssue.column <> "" Then 3184cdf0e10cSrcweir out.WriteLine "<property name=""column"" value=""" & myIssue.column & """ />" 3185cdf0e10cSrcweir End If 3186cdf0e10cSrcweir out.WriteLine "</location>" 3187cdf0e10cSrcweir 3188cdf0e10cSrcweirFinalExit: 3189cdf0e10cSrcweir Exit Sub 3190cdf0e10cSrcweir 3191cdf0e10cSrcweirHandleErrors: 3192cdf0e10cSrcweir WriteDebug currentFunctionName & " : path " & aAnalysis.name & " : myIssue " & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML & ": " & Err.Number & " " & Err.Description & " " & Err.Source 3193cdf0e10cSrcweir Resume FinalExit 3194cdf0e10cSrcweirEnd Sub 3195cdf0e10cSrcweir 3196cdf0e10cSrcweirSub OutputXMLCommonIssueAttributes(out As TextStream, myIssue As IssueInfo) 3197cdf0e10cSrcweir On Error GoTo HandleErrors 3198cdf0e10cSrcweir Dim currentFunctionName As String 3199cdf0e10cSrcweir currentFunctionName = "OutputXMLCommonIssueAttributes" 3200cdf0e10cSrcweir 3201cdf0e10cSrcweir Dim index As Integer 3202cdf0e10cSrcweir Dim valStr As String 3203cdf0e10cSrcweir Dim attStr As String 3204cdf0e10cSrcweir 3205cdf0e10cSrcweir If myIssue.Attributes.count = 0 Then Exit Sub 3206cdf0e10cSrcweir 3207cdf0e10cSrcweir out.WriteLine "<details>" 3208cdf0e10cSrcweir For index = 1 To myIssue.Attributes.count 3209cdf0e10cSrcweir attStr = myIssue.Attributes(index) 3210cdf0e10cSrcweir If InStr(attStr, RID_STR_COMMON_NOTE_PRE & "[") = 1 Then 3211cdf0e10cSrcweir attStr = Right$(attStr, Len(attStr) - Len(RID_STR_COMMON_NOTE_PRE & "[")) 3212cdf0e10cSrcweir attStr = Left$(attStr, Len(attStr) - 1) 3213cdf0e10cSrcweir out.WriteLine "<note index=""" & attStr & """ value=""" & EncodeXML(myIssue.Values(index)) & """ />" 3214cdf0e10cSrcweir Else 3215cdf0e10cSrcweir out.WriteLine "<property name=""" & EncodeXML(myIssue.Attributes(index)) & """ value=""" & EncodeXML(myIssue.Values(index)) & """ />" 3216cdf0e10cSrcweir End If 3217cdf0e10cSrcweir Next index 3218cdf0e10cSrcweir 3219cdf0e10cSrcweir out.WriteLine "</details>" 3220cdf0e10cSrcweir 3221cdf0e10cSrcweirFinalExit: 3222cdf0e10cSrcweir Exit Sub 3223cdf0e10cSrcweir 3224cdf0e10cSrcweirHandleErrors: 3225cdf0e10cSrcweir WriteDebug currentFunctionName & " : myIssue " & myIssue.IssueTypeXML & "_" & myIssue.SubTypeXML & ": " & Err.Number & " " & Err.Description & " " & Err.Source 3226cdf0e10cSrcweir Resume FinalExit 3227cdf0e10cSrcweirEnd Sub 3228cdf0e10cSrcweir 3229cdf0e10cSrcweir 3230cdf0e10cSrcweirSub WriteXMLOutput(storeToDir As String, resultsFile As String, _ 3231cdf0e10cSrcweir bOverwriteResultsFile As Boolean, bNewResultsFile As Boolean, AnalysedDocs As Collection, _ 3232cdf0e10cSrcweir fso As Scripting.FileSystemObject) 3233cdf0e10cSrcweir 3234cdf0e10cSrcweir On Error GoTo HandleErrors 3235cdf0e10cSrcweir Dim currentFunctionName As String 3236cdf0e10cSrcweir currentFunctionName = "WriteXMLOutput" 3237cdf0e10cSrcweir 3238cdf0e10cSrcweir Dim xmlOutput As TextStream 3239cdf0e10cSrcweir Dim xmlOrigOutput As TextStream 3240cdf0e10cSrcweir Dim origOutput As String 3241cdf0e10cSrcweir Dim analysis As DocumentAnalysis 3242cdf0e10cSrcweir Dim outFilePath As String 3243cdf0e10cSrcweir 3244cdf0e10cSrcweir outFilePath = storeToDir & "\" & fso.GetBaseName(resultsFile) & "_" & _ 3245cdf0e10cSrcweir getAppSpecificApplicationName & ".xml" 3246cdf0e10cSrcweir 3247cdf0e10cSrcweir Set xmlOutput = fso.CreateTextFile(outFilePath, True) 3248cdf0e10cSrcweir WriteXMLHeader xmlOutput 3249cdf0e10cSrcweir 3250cdf0e10cSrcweir 'Set xmlOrigOutput = fso.OpenTextFile(outFilePath, ForReading) 3251cdf0e10cSrcweir 'Set xmlOutput = fso.OpenTextFile(outFilePath, ForWriting) 3252cdf0e10cSrcweir 3253cdf0e10cSrcweir WriteXMLResultsStartTag xmlOutput 3254cdf0e10cSrcweir For Each analysis In AnalysedDocs 3255cdf0e10cSrcweir WriteXMLDocProperties xmlOutput, analysis 3256cdf0e10cSrcweir WriteXMLDocRefDetails xmlOutput, analysis 3257cdf0e10cSrcweir WriteXMLDocIssueDetails xmlOutput, analysis 3258cdf0e10cSrcweir WriteXMLDocPropertiesEndTag xmlOutput 3259cdf0e10cSrcweir Next analysis 3260cdf0e10cSrcweir WriteXMLResultsEndTag xmlOutput 3261cdf0e10cSrcweir 3262cdf0e10cSrcweirFinalExit: 3263cdf0e10cSrcweir xmlOutput.Close 3264cdf0e10cSrcweir Set xmlOutput = Nothing 3265cdf0e10cSrcweir Exit Sub 3266cdf0e10cSrcweir 3267cdf0e10cSrcweirHandleErrors: 3268cdf0e10cSrcweir WriteDebug currentFunctionName & " : path " & outFilePath & ": " & Err.Number & " " & Err.Description & " " & Err.Source 3269cdf0e10cSrcweir Resume FinalExit 3270cdf0e10cSrcweirEnd Sub 3271cdf0e10cSrcweir 3272cdf0e10cSrcweirPrivate Function EncodeUrl(ByVal sUrl As String) As String 3273cdf0e10cSrcweir Const MAX_PATH As Long = 260 3274cdf0e10cSrcweir Const ERROR_SUCCESS As Long = 0 3275cdf0e10cSrcweir Const URL_DONT_SIMPLIFY As Long = &H8000000 3276cdf0e10cSrcweir On Error GoTo HandleErrors 3277cdf0e10cSrcweir Dim currentFunctionName As String 3278cdf0e10cSrcweir currentFunctionName = "EncodeUrl" 3279cdf0e10cSrcweir 3280cdf0e10cSrcweir Dim sUrlEsc As String 3281cdf0e10cSrcweir Dim dwSize As Long 3282cdf0e10cSrcweir Dim dwFlags As Long 3283cdf0e10cSrcweir 3284cdf0e10cSrcweir If Len(sUrl) > 0 Then 3285cdf0e10cSrcweir 3286cdf0e10cSrcweir sUrlEsc = Space$(MAX_PATH) 3287cdf0e10cSrcweir dwSize = Len(sUrlEsc) 3288cdf0e10cSrcweir dwFlags = URL_DONT_SIMPLIFY 3289cdf0e10cSrcweir 3290cdf0e10cSrcweir If UrlEscape(sUrl, _ 3291cdf0e10cSrcweir sUrlEsc, _ 3292cdf0e10cSrcweir dwSize, _ 3293cdf0e10cSrcweir dwFlags) = ERROR_SUCCESS Then 3294cdf0e10cSrcweir 3295cdf0e10cSrcweir EncodeUrl = Left$(sUrlEsc, dwSize) 3296cdf0e10cSrcweir 3297cdf0e10cSrcweir End If 'If UrlEscape 3298cdf0e10cSrcweir End If 'If Len(sUrl) > 0 3299cdf0e10cSrcweir 3300cdf0e10cSrcweirFinalExit: 3301cdf0e10cSrcweir Exit Function 3302cdf0e10cSrcweir 3303cdf0e10cSrcweirHandleErrors: 3304cdf0e10cSrcweir WriteDebug currentFunctionName & " : sUrl " & sUrl & ": " & Err.Number & " " & Err.Description & " " & Err.Source 3305cdf0e10cSrcweir Resume FinalExit 3306cdf0e10cSrcweirEnd Function 3307cdf0e10cSrcweir 3308cdf0e10cSrcweirPrivate Function EncodeXML(Str As String) As String 3309cdf0e10cSrcweir On Error GoTo HandleErrors 3310cdf0e10cSrcweir Dim currentFunctionName As String 3311cdf0e10cSrcweir currentFunctionName = "EncodeXML" 3312cdf0e10cSrcweir 3313cdf0e10cSrcweir Str = Replace(Str, "^", "^") 3314cdf0e10cSrcweir Str = Replace(Str, "&", "&") 3315cdf0e10cSrcweir Str = Replace(Str, "`", "'") 3316cdf0e10cSrcweir Str = Replace(Str, "{", "{") 3317cdf0e10cSrcweir Str = Replace(Str, "}", "}") 3318cdf0e10cSrcweir Str = Replace(Str, "|", "|") 3319cdf0e10cSrcweir Str = Replace(Str, "]", "]") 3320cdf0e10cSrcweir Str = Replace(Str, "[", "[") 3321cdf0e10cSrcweir Str = Replace(Str, """", """) 3322cdf0e10cSrcweir Str = Replace(Str, "<", "<") 3323cdf0e10cSrcweir Str = Replace(Str, ">", ">") 3324cdf0e10cSrcweir 3325cdf0e10cSrcweir 'str = Replace(str, "\", "\") 3326cdf0e10cSrcweir 'str = Replace(str, "#", "#") 3327cdf0e10cSrcweir 'str = Replace(str, "?", "?") 3328cdf0e10cSrcweir 'str = Replace(str, "/", "/") 3329cdf0e10cSrcweir 3330cdf0e10cSrcweir EncodeXML = Str 3331cdf0e10cSrcweir 3332cdf0e10cSrcweirFinalExit: 3333cdf0e10cSrcweir Exit Function 3334cdf0e10cSrcweir 3335cdf0e10cSrcweirHandleErrors: 3336cdf0e10cSrcweir WriteDebug currentFunctionName & " : string " & Str & ": " & Err.Number & " " & Err.Description & " " & Err.Source 3337cdf0e10cSrcweir Resume FinalExit 3338cdf0e10cSrcweirEnd Function 3339cdf0e10cSrcweir 3340cdf0e10cSrcweir 3341cdf0e10cSrcweirFunction ReplaceTopicTokens(sString As String, _ 3342cdf0e10cSrcweir sToken As String, _ 3343cdf0e10cSrcweir sReplacement As String) As String 3344cdf0e10cSrcweir On Error Resume Next 3345cdf0e10cSrcweir 3346cdf0e10cSrcweir Dim p As Integer 3347cdf0e10cSrcweir Dim sTmp As String 3348cdf0e10cSrcweir 3349cdf0e10cSrcweir sTmp = sString 3350cdf0e10cSrcweir Do 3351cdf0e10cSrcweir p = InStr(sTmp, sToken) 3352cdf0e10cSrcweir If p Then 3353cdf0e10cSrcweir sTmp = Left(sTmp, p - 1) + sReplacement + Mid(sTmp, p + Len(sToken)) 3354cdf0e10cSrcweir End If 3355cdf0e10cSrcweir Loop While p > 0 3356cdf0e10cSrcweir 3357cdf0e10cSrcweir 3358cdf0e10cSrcweir ReplaceTopicTokens = sTmp 3359cdf0e10cSrcweir 3360cdf0e10cSrcweirEnd Function 3361cdf0e10cSrcweir 3362cdf0e10cSrcweirFunction ReplaceTopic2Tokens(sString As String, _ 3363cdf0e10cSrcweir sToken1 As String, _ 3364cdf0e10cSrcweir sReplacement1 As String, _ 3365cdf0e10cSrcweir sToken2 As String, _ 3366cdf0e10cSrcweir sReplacement2 As String) As String 3367cdf0e10cSrcweir On Error Resume Next 3368cdf0e10cSrcweir 3369cdf0e10cSrcweir ReplaceTopic2Tokens = _ 3370cdf0e10cSrcweir ReplaceTopicTokens(ReplaceTopicTokens(sString, sToken1, sReplacement1), _ 3371cdf0e10cSrcweir sToken2, sReplacement2) 3372cdf0e10cSrcweirEnd Function 3373cdf0e10cSrcweir 3374cdf0e10cSrcweir'Language setting functions 3375cdf0e10cSrcweirFunction GetResourceDataFileName(thisDir As String) As String 3376cdf0e10cSrcweir On Error GoTo HandleErrors 3377cdf0e10cSrcweir Dim currentFunctionName As String 3378cdf0e10cSrcweir currentFunctionName = "GetResourceDataFileName" 3379cdf0e10cSrcweir 3380cdf0e10cSrcweir Dim fso As FileSystemObject 3381cdf0e10cSrcweir Set fso = New FileSystemObject 3382cdf0e10cSrcweir 3383cdf0e10cSrcweir 'A debug method - if a file called debug.dat exists load it. 3384cdf0e10cSrcweir If fso.FileExists(fso.GetAbsolutePathName(thisDir & "\debug.dat")) Then 3385cdf0e10cSrcweir GetResourceDataFileName = fso.GetAbsolutePathName(thisDir & "\debug.dat") 3386cdf0e10cSrcweir GoTo FinalExit 3387cdf0e10cSrcweir End If 3388cdf0e10cSrcweir 3389cdf0e10cSrcweir Dim isoLangStr As String 3390cdf0e10cSrcweir Dim isoCountryStr As String 3391cdf0e10cSrcweir Dim langDir As String 3392cdf0e10cSrcweir 3393cdf0e10cSrcweir langDir = thisDir & "\" & "lang" 3394cdf0e10cSrcweir 3395cdf0e10cSrcweir Dim userLCID As Long 3396cdf0e10cSrcweir userLCID = GetUserDefaultLangID() 3397cdf0e10cSrcweir Dim sysLCID As Long 3398cdf0e10cSrcweir sysLCID = GetSystemDefaultLangID() 3399cdf0e10cSrcweir 3400cdf0e10cSrcweir isoLangStr = GetUserLocaleInfo(userLCID, LOCALE_SISO639LANGNAME) 3401cdf0e10cSrcweir isoCountryStr = GetUserLocaleInfo(userLCID, LOCALE_SISO3166CTRYNAME) 3402cdf0e10cSrcweir 3403cdf0e10cSrcweir 'check for locale data in following order: 3404cdf0e10cSrcweir ' user language 3405cdf0e10cSrcweir ' isoLangStr & "_" & isoCountryStr & ".dat" 3406cdf0e10cSrcweir ' isoLangStr & ".dat" 3407cdf0e10cSrcweir ' system language 3408cdf0e10cSrcweir ' isoLangStr & "_" & isoCountryStr & ".dat" 3409cdf0e10cSrcweir ' isoLangStr & ".dat" 3410cdf0e10cSrcweir ' "en_US" & ".dat" 3411cdf0e10cSrcweir 3412cdf0e10cSrcweir If fso.FileExists(fso.GetAbsolutePathName(langDir & "\" & isoLangStr & "-" & isoCountryStr & ".dat")) Then 3413cdf0e10cSrcweir GetResourceDataFileName = fso.GetAbsolutePathName(langDir & "\" & isoLangStr & "-" & isoCountryStr & ".dat") 3414cdf0e10cSrcweir ElseIf fso.FileExists(fso.GetAbsolutePathName(langDir & "\" & isoLangStr & ".dat")) Then 3415cdf0e10cSrcweir GetResourceDataFileName = fso.GetAbsolutePathName(langDir & "\" & isoLangStr & ".dat") 3416cdf0e10cSrcweir Else 3417cdf0e10cSrcweir isoLangStr = GetUserLocaleInfo(sysLCID, LOCALE_SISO639LANGNAME) 3418cdf0e10cSrcweir isoCountryStr = GetUserLocaleInfo(sysLCID, LOCALE_SISO3166CTRYNAME) 3419cdf0e10cSrcweir 3420cdf0e10cSrcweir If fso.FileExists(fso.GetAbsolutePathName(langDir & "\" & isoLangStr & "-" & isoCountryStr & ".dat")) Then 3421cdf0e10cSrcweir GetResourceDataFileName = fso.GetAbsolutePathName(langDir & "\" & isoLangStr & "-" & isoCountryStr & ".dat") 3422cdf0e10cSrcweir ElseIf fso.FileExists(fso.GetAbsolutePathName(langDir & "\" & isoLangStr & ".dat")) Then 3423cdf0e10cSrcweir GetResourceDataFileName = fso.GetAbsolutePathName(langDir & "\" & isoLangStr & ".dat") 3424cdf0e10cSrcweir Else 3425cdf0e10cSrcweir GetResourceDataFileName = fso.GetAbsolutePathName(langDir & "\" & "en-US.dat") 3426cdf0e10cSrcweir End If 3427cdf0e10cSrcweir End If 3428cdf0e10cSrcweirFinalExit: 3429cdf0e10cSrcweir Set fso = Nothing 3430cdf0e10cSrcweir Exit Function 3431cdf0e10cSrcweir 3432cdf0e10cSrcweirHandleErrors: 3433cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 3434cdf0e10cSrcweir Resume FinalExit 3435cdf0e10cSrcweirEnd Function 3436cdf0e10cSrcweir 3437cdf0e10cSrcweirPublic Function GetUserLocaleInfo(ByVal dwLocaleID As Long, ByVal dwLCType As Long) As String 3438cdf0e10cSrcweir On Error GoTo HandleErrors 3439cdf0e10cSrcweir Dim currentFunctionName As String 3440cdf0e10cSrcweir currentFunctionName = "GetUserLocaleInfo" 3441cdf0e10cSrcweir Dim sReturn As String 3442cdf0e10cSrcweir Dim r As Long 3443cdf0e10cSrcweir 3444cdf0e10cSrcweir 'call the function passing the Locale type 3445cdf0e10cSrcweir 'variable to retrieve the required size of 3446cdf0e10cSrcweir 'the string buffer needed 3447cdf0e10cSrcweir r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn)) 3448cdf0e10cSrcweir 3449cdf0e10cSrcweir 'if successful.. 3450cdf0e10cSrcweir If r Then 3451cdf0e10cSrcweir 'pad the buffer with spaces 3452cdf0e10cSrcweir sReturn = Space$(r) 3453cdf0e10cSrcweir 3454cdf0e10cSrcweir 'and call again passing the buffer 3455cdf0e10cSrcweir r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn)) 3456cdf0e10cSrcweir 3457cdf0e10cSrcweir 'if successful (r > 0) 3458cdf0e10cSrcweir If r Then 3459cdf0e10cSrcweir 'r holds the size of the string 3460cdf0e10cSrcweir 'including the terminating null 3461cdf0e10cSrcweir GetUserLocaleInfo = Left$(sReturn, r - 1) 3462cdf0e10cSrcweir End If 3463cdf0e10cSrcweir End If 3464cdf0e10cSrcweir 3465cdf0e10cSrcweirFinalExit: 3466cdf0e10cSrcweir Exit Function 3467cdf0e10cSrcweir 3468cdf0e10cSrcweirHandleErrors: 3469cdf0e10cSrcweir WriteDebug currentFunctionName & ": " & Err.Number & " " & Err.Description & " " & Err.Source 3470cdf0e10cSrcweir Resume FinalExit 3471cdf0e10cSrcweirEnd Function 3472cdf0e10cSrcweir 3473cdf0e10cSrcweir' This function returns the Application Data Folder Path 3474cdf0e10cSrcweirFunction GetAppDataFolder() As String 3475cdf0e10cSrcweir Dim idlstr As Long 3476cdf0e10cSrcweir Dim sPath As String 3477cdf0e10cSrcweir Dim IDL As ITEMIDLIST 3478cdf0e10cSrcweir Const NOERROR = 0 3479cdf0e10cSrcweir Const MAX_LENGTH = 260 3480cdf0e10cSrcweir Const CSIDL_APPDATA = &H1A 3481cdf0e10cSrcweir 3482cdf0e10cSrcweir On Error GoTo Err_GetFolder 3483cdf0e10cSrcweir 3484cdf0e10cSrcweir ' Fill the idl structure with the specified folder item. 3485cdf0e10cSrcweir idlstr = SHGetSpecialFolderLocation(0, CSIDL_APPDATA, IDL) 3486cdf0e10cSrcweir 3487cdf0e10cSrcweir If idlstr = NOERROR Then 3488cdf0e10cSrcweir ' Get the path from the idl list, and return 3489cdf0e10cSrcweir ' the folder with a slash at the end. 3490cdf0e10cSrcweir sPath = Space$(MAX_LENGTH) 3491cdf0e10cSrcweir idlstr = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath) 3492cdf0e10cSrcweir If idlstr Then 3493cdf0e10cSrcweir GetAppDataFolder = Left$(sPath, InStr(sPath, Chr$(0)) - 1) 3494cdf0e10cSrcweir End If 3495cdf0e10cSrcweir End If 3496cdf0e10cSrcweir 3497cdf0e10cSrcweirExit_GetFolder: 3498cdf0e10cSrcweir Exit Function 3499cdf0e10cSrcweir 3500cdf0e10cSrcweirErr_GetFolder: 3501cdf0e10cSrcweir MsgBox "An Error was Encountered" & Chr(13) & Err.Description, _ 3502cdf0e10cSrcweir vbCritical Or vbOKOnly 3503cdf0e10cSrcweir Resume Exit_GetFolder 3504cdf0e10cSrcweir 3505cdf0e10cSrcweirEnd Function 3506cdf0e10cSrcweir 3507cdf0e10cSrcweirSub WriteToStatFile(statFileName As String, statValue As Integer, _ 3508cdf0e10cSrcweir currDocument As String, fso As Scripting.FileSystemObject) 3509cdf0e10cSrcweir 3510cdf0e10cSrcweir On Error Resume Next 3511cdf0e10cSrcweir 3512cdf0e10cSrcweir Dim fileCont As TextStream 3513cdf0e10cSrcweir 3514cdf0e10cSrcweir Set fileCont = fso.OpenTextFile(statFileName, ForWriting, True, TristateTrue) 3515cdf0e10cSrcweir If (statValue = C_STAT_STARTING) Then 3516cdf0e10cSrcweir fileCont.WriteLine ("analysing=" & currDocument) 3517cdf0e10cSrcweir ElseIf (statValue = C_STAT_DONE) Then 3518cdf0e10cSrcweir fileCont.WriteLine ("analysed=" & currDocument) 3519cdf0e10cSrcweir ElseIf (statValue = C_STAT_FINISHED) Then 3520cdf0e10cSrcweir fileCont.WriteLine ("finished") 3521cdf0e10cSrcweir End If 3522cdf0e10cSrcweir 3523cdf0e10cSrcweir fileCont.Close 3524cdf0e10cSrcweirEnd Sub 3525cdf0e10cSrcweir 3526cdf0e10cSrcweir' The function FindIndex looks for a document in the given document list 3527cdf0e10cSrcweir' starting at the position lastIndex in that list. If the document could 3528cdf0e10cSrcweir' not be found, the function starts searching from the beginning 3529cdf0e10cSrcweir 3530cdf0e10cSrcweirFunction FindIndex(myDocument As String, _ 3531cdf0e10cSrcweir myDocList As Collection, _ 3532cdf0e10cSrcweir lastIndex As Long) As Long 3533cdf0e10cSrcweir 3534cdf0e10cSrcweir Dim lastEntry As Long 3535cdf0e10cSrcweir Dim curIndex As Long 3536cdf0e10cSrcweir Dim curEntry As String 3537cdf0e10cSrcweir Dim entryFound As Boolean 3538cdf0e10cSrcweir 3539cdf0e10cSrcweir entryFound = False 3540cdf0e10cSrcweir lastEntry = myDocList.count 3541cdf0e10cSrcweir 3542cdf0e10cSrcweir If (lastIndex > lastEntry) Then lastIndex = lastEntry 3543cdf0e10cSrcweir 3544cdf0e10cSrcweir If (lastIndex > 1) Then 3545cdf0e10cSrcweir curIndex = lastIndex 3546cdf0e10cSrcweir Else 3547cdf0e10cSrcweir curIndex = 1 3548cdf0e10cSrcweir End If 3549cdf0e10cSrcweir 3550cdf0e10cSrcweir While Not entryFound And curIndex <= lastEntry 3551cdf0e10cSrcweir curEntry = myDocList.item(curIndex) 3552cdf0e10cSrcweir If (curEntry = myDocument) Then 3553cdf0e10cSrcweir entryFound = True 3554cdf0e10cSrcweir Else 3555cdf0e10cSrcweir curIndex = curIndex + 1 3556cdf0e10cSrcweir End If 3557cdf0e10cSrcweir Wend 3558cdf0e10cSrcweir 3559cdf0e10cSrcweir If (Not entryFound) Then 3560cdf0e10cSrcweir curIndex = 1 3561cdf0e10cSrcweir While Not entryFound And curIndex < lastIndex 3562cdf0e10cSrcweir curEntry = myDocList.item(curIndex) 3563cdf0e10cSrcweir If (curEntry = myDocument) Then 3564cdf0e10cSrcweir entryFound = True 3565cdf0e10cSrcweir Else 3566cdf0e10cSrcweir curIndex = curIndex + 1 3567cdf0e10cSrcweir End If 3568cdf0e10cSrcweir Wend 3569cdf0e10cSrcweir End If 3570cdf0e10cSrcweir 3571cdf0e10cSrcweir If entryFound Then 3572cdf0e10cSrcweir FindIndex = curIndex 3573cdf0e10cSrcweir Else 3574cdf0e10cSrcweir FindIndex = 0 3575cdf0e10cSrcweir End If 3576cdf0e10cSrcweir 3577cdf0e10cSrcweirEnd Function 3578cdf0e10cSrcweir 3579cdf0e10cSrcweir' The sub GetIndexValues calulates the start index of the analysis and the index 3580cdf0e10cSrcweir' of the file after which the next intermediate reult will be written 3581cdf0e10cSrcweirFunction GetIndexValues(startIndex As Long, nextCheck As Long, _ 3582cdf0e10cSrcweir myFiles As Collection) As Boolean 3583cdf0e10cSrcweir 3584cdf0e10cSrcweir Dim lastCheckpoint As String 3585cdf0e10cSrcweir Dim nextFile As String 3586cdf0e10cSrcweir Dim newResultsFile As Boolean 3587cdf0e10cSrcweir 3588cdf0e10cSrcweir lastCheckpoint = ProfileGetItem(C_ANALYSIS, C_LAST_CHECKPOINT, "", mIniFilePath) 3589cdf0e10cSrcweir nextFile = ProfileGetItem(C_ANALYSIS, C_NEXT_FILE, "", mIniFilePath) 3590cdf0e10cSrcweir newResultsFile = True 3591cdf0e10cSrcweir 3592cdf0e10cSrcweir If (nextFile = "") Then 3593cdf0e10cSrcweir ' No Analysis done yet 3594cdf0e10cSrcweir startIndex = 1 3595cdf0e10cSrcweir nextCheck = C_MAX_CHECK 3596cdf0e10cSrcweir Else 3597cdf0e10cSrcweir If (lastCheckpoint = "") Then 3598cdf0e10cSrcweir startIndex = 1 3599cdf0e10cSrcweir Else 3600cdf0e10cSrcweir startIndex = FindIndex(lastCheckpoint, myFiles, 1) + 1 3601cdf0e10cSrcweir If (startIndex > 0) Then newResultsFile = False 3602cdf0e10cSrcweir End If 3603cdf0e10cSrcweir 3604cdf0e10cSrcweir nextCheck = FindIndex(nextFile, myFiles, startIndex - 1) 3605cdf0e10cSrcweir 3606cdf0e10cSrcweir If (nextCheck = 0) Then ' Next file not in file list, restarting 3607cdf0e10cSrcweir startIndex = 1 3608cdf0e10cSrcweir nextCheck = C_MAX_CHECK 3609cdf0e10cSrcweir newResultsFile = True 3610cdf0e10cSrcweir ElseIf (nextCheck < startIndex) Then 'we are done? 3611cdf0e10cSrcweir nextCheck = startIndex + C_MAX_CHECK 3612cdf0e10cSrcweir ElseIf (nextCheck = startIndex) Then 'skip this one 3613cdf0e10cSrcweir WriteToLog C_ERROR_HANDLING_DOC & nextCheck, nextFile 3614cdf0e10cSrcweir startIndex = startIndex + 1 3615cdf0e10cSrcweir nextCheck = startIndex + C_MAX_CHECK 3616cdf0e10cSrcweir Else 'last time an error occured with that file, write before analysing 3617cdf0e10cSrcweir nextCheck = nextCheck - 1 3618cdf0e10cSrcweir End If 3619cdf0e10cSrcweir End If 3620cdf0e10cSrcweir GetIndexValues = newResultsFile 3621cdf0e10cSrcweirEnd Function 3622cdf0e10cSrcweir 3623cdf0e10cSrcweirPrivate Sub GetDocModificationDates(docCounts As DocModificationDates) 3624cdf0e10cSrcweir 3625cdf0e10cSrcweir On Error GoTo HandleErrors 3626cdf0e10cSrcweir Dim currentFunctionName As String 3627cdf0e10cSrcweir currentFunctionName = "GetDocModificationDates" 3628cdf0e10cSrcweir 3629cdf0e10cSrcweir docCounts.lessThanThreemonths = CLng(ProfileGetItem("Analysis", C_DOCS_LESS_3_MONTH, "0", mIniFilePath)) 3630cdf0e10cSrcweir docCounts.threeToSixmonths = CLng(ProfileGetItem("Analysis", C_DOCS_LESS_6_MONTH, "0", mIniFilePath)) 3631cdf0e10cSrcweir docCounts.sixToTwelvemonths = CLng(ProfileGetItem("Analysis", C_DOCS_LESS_12_MONTH, "0", mIniFilePath)) 3632cdf0e10cSrcweir docCounts.greaterThanOneYear = CLng(ProfileGetItem("Analysis", C_DOCS_MORE_12_MONTH, "0", mIniFilePath)) 3633cdf0e10cSrcweir 3634cdf0e10cSrcweirFinalExit: 3635cdf0e10cSrcweir Exit Sub 3636cdf0e10cSrcweirHandleErrors: 3637cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 3638cdf0e10cSrcweir Resume FinalExit 3639cdf0e10cSrcweirEnd Sub 3640