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