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