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