1VERSION 1.0 CLASS
2BEGIN
3  MultiUse = -1  'True
4END
5Attribute VB_Name = "MigrationAnalyser"
6Attribute VB_GlobalNameSpace = False
7Attribute VB_Creatable = False
8Attribute VB_PredeclaredId = False
9Attribute VB_Exposed = False
10'*************************************************************************
11'
12'  Licensed to the Apache Software Foundation (ASF) under one
13'  or more contributor license agreements.  See the NOTICE file
14'  distributed with this work for additional information
15'  regarding copyright ownership.  The ASF licenses this file
16'  to you under the Apache License, Version 2.0 (the
17'  "License"); you may not use this file except in compliance
18'  with the License.  You may obtain a copy of the License at
19'
20'    http://www.apache.org/licenses/LICENSE-2.0
21'
22'  Unless required by applicable law or agreed to in writing,
23'  software distributed under the License is distributed on an
24'  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
25'  KIND, either express or implied.  See the License for the
26'  specific language governing permissions and limitations
27'  under the License.
28'
29'*************************************************************************
30
31Option Explicit
32
33'Class variables
34Private Enum HFIssueType
35    hfInline
36    hfShape
37    hfFrame
38End Enum
39
40Private Enum HFIssueLocation
41    hfHeader
42    hffooter
43End Enum
44
45
46Private Type ShapeInfo
47        top As Single
48        Height As Single
49End Type
50
51Private Type FrameInfo
52        Height As Single
53        VerticalPosition As Single
54End Type
55
56Private mAnalysis As DocumentAnalysis
57Private mOdd As Boolean
58Private mbFormFieldErrorLogged As Boolean
59Private mbRefFormFieldErrorLogged As Boolean
60
61'***ADDING-ISSUE: Use Following Skeleton as Guideline for Adding Issue
62' For complete list of all RID_STR_... for Issues (IssueType), SubIssues (SubType) and Attributes refer to:
63'   word_res.bas and common_res.bas
64'
65' For complete list of all CID_... for Issue Categories(IssueID) and
66' CSTR_... for XML Issues (IssueTypeXML) and XML SubIssues (SubTypeXML) refer to:
67'   ApplicationSpecific.bas and CommonMigrationAnalyser.bas
68'
69' You should not have to add any new Issue Categories or matching IssueTypes, only new SubIssues
70Sub Analyze_SKELETON()
71    On Error GoTo HandleErrors
72    Dim currentFunctionName As String
73    currentFunctionName = "Analyze_SKELETON"
74    Dim myIssue As IssueInfo
75    Set myIssue = New IssueInfo
76
77    With myIssue
78        .IssueID = CID_VBA_MACROS 'Issue Category
79        .IssueType = RID_STR_COMMON_ISSUE_VBA_MACROS 'Issue String
80        .SubType = RID_STR_COMMON_SUBISSUE_PROPERTIES 'SubIssue String
81        .Location = .CLocationDocument 'Location string
82
83        .IssueTypeXML = CSTR_ISSUE_VBA_MACROS 'Non localised XML Issue String
84        .SubTypeXML = CSTR_SUBISSUE_PROPERTIES 'Non localised XML SubIssue String
85        .locationXML = .CXMLLocationDocument 'Non localised XML location
86
87        .SubLocation = 0 'if not set will default to RID_STR_NOT_AVAILABLE_SHORTHAND
88        .Line = 0 'if not set will default to RID_STR_NOT_AVAILABLE_SHORTHAND
89        .column = 0 'if not set will default to RID_STR_NOT_AVAILABLE_SHORTHAND
90
91        ' Add as many Attribute Value pairs as needed
92        ' Note: following must always be true - Attributes.Count = Values.Count
93        .Attributes.Add "AAA"
94        .Values.Add "foobar"
95
96        ' Use AddIssueDetailsNote to add notes to the Issue Details if required
97        ' Public Sub AddIssueDetailsNote(myIssue As IssueInfo, noteNum As Long, noteStr As String, _
98        '   Optional preStr As String = RID_STR_COMMON_NOTE_PRE)
99        ' Where preStr is prepended to the output, with "Note" as the default
100         AddIssueDetailsNote myIssue, 0, RID_STR_COMMON_NOTE_DOCUMENT_PROPERTIES_LOST
101
102         'Only put this in if you have a preparation function added for this issue in CommonPreparation
103         'or Preparation - NUll can be replaced with any variant if you want to pass info to the Prepare fnc
104         Call DoPreparation(mAnalysis, myIssue, "", Null, Null)
105
106         mAnalysis.IssuesCountArray(CID_VBA_MACROS) = _
107                mAnalysis.IssuesCountArray(CID_VBA_MACROS) + 1
108    End With
109
110    mAnalysis.Issues.Add myIssue
111
112FinalExit:
113    Set myIssue = Nothing
114    Exit Sub
115
116HandleErrors:
117    WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
118    Resume FinalExit
119End Sub
120
121Sub DoAnalyse(fileName As String, userFormTypesDict As Scripting.Dictionary, _
122    startDir As String, storeToDir As String, fso As FileSystemObject)
123    On Error GoTo HandleErrors
124    Dim currentFunctionName As String
125    currentFunctionName = "DoAnalyse"
126    mAnalysis.name = fileName
127    Dim aDoc As Document
128    Dim bUnprotectError As Boolean
129    mAnalysis.TotalIssueTypes = CTOTAL_CATEGORIES
130    mbFormFieldErrorLogged = False
131    mbRefFormFieldErrorLogged = False
132
133    'Turn off any AutoExce macros before loading the Word doc
134    On Error Resume Next ' Ignore errors on setting
135    WordBasic.DisableAutoMacros 1
136    On Error GoTo HandleErrors
137
138    Dim myPassword As String
139    myPassword = GetDefaultPassword
140
141    'Always skip password protected documents
142    'If IsSkipPasswordDocs() Then
143    Dim aPass As String
144    If myPassword <> "" Then
145        aPass = myPassword
146    Else
147        aPass = "xoxoxoxoxo"
148    End If
149
150    On Error Resume Next
151    Set aDoc = Documents.Open(fileName, False, False, False, _
152                            aPass, aPass, False, aPass, aPass, wdOpenFormatAuto, _
153                            msoEncodingAutoDetect, False)
154    If Err.Number = 5408 Then
155        ' if password protected, try open readonly next
156        Set aDoc = Documents.Open(fileName, False, True, False, _
157                    aPass, aPass, False, aPass, aPass, wdOpenFormatAuto, _
158                    msoEncodingAutoDetect, False)
159    End If
160    If Err.Number = 5408 Then
161        HandleProtectedDocInvalidPassword mAnalysis, _
162            "User entered Invalid Document Password, further analysis not possible", fso
163        Analyze_Password_Protection True, False
164        GoTo FinalExit
165    ElseIf (Err.Number <> 0) Then
166        GoTo HandleErrors
167    End If
168
169    On Error GoTo HandleErrors
170
171    If aDoc Is Nothing Then GoTo FinalExit
172
173    'Do Analysis
174    Analyze_Password_Protection aDoc.HasPassword, aDoc.WriteReserved
175    Analyze_Document_Protection aDoc
176
177    If aDoc.ProtectionType <> wdNoProtection Then
178        If myPassword <> "" Then
179            aDoc.Unprotect (myPassword)
180        Else
181            aDoc.Unprotect
182        End If
183    End If
184
185    'Set Doc Properties
186    SetDocProperties mAnalysis, aDoc, fso
187
188ContinueFromUnprotectError:
189
190    Analyze_Tables_TablesInTables aDoc
191    Analyze_Tables_Borders aDoc
192    Analyze_TOA aDoc
193    If Not bUnprotectError Then
194        Analyze_FieldAndFormFieldIssues aDoc
195    End If
196    Analyze_OLEEmbedded aDoc
197    Analyze_MailMerge_DataSource aDoc
198    Analyze_Macros mAnalysis, userFormTypesDict, aDoc
199    'Analyze_Numbering aDoc, mAnalysis
200    'Analyze_NumberingTabs aDoc, mAnalysis
201
202    ' Doc Preparation only
203    ' Save document with any prepared issues under <storeToDir>\prepared\<source doc name>
204    If mAnalysis.PreparableIssuesCount > 0 And CheckDoPrepare Then
205        Dim preparedFullPath As String
206        preparedFullPath = GetPreparedFullPath(mAnalysis.name, startDir, storeToDir, fso)
207        If preparedFullPath <> "" Then
208            If fso.FileExists(preparedFullPath) Then
209                fso.DeleteFile preparedFullPath, True
210            End If
211            If fso.FolderExists(fso.GetParentFolderName(preparedFullPath)) Then
212                    aDoc.SaveAs preparedFullPath
213            End If
214        End If
215    End If
216
217    'DebugMacroInfo
218
219FinalExit:
220
221
222    If Not aDoc Is Nothing Then 'If Not IsEmpty(aDoc) Then
223        aDoc.Close (False)
224    End If
225    Set aDoc = Nothing
226
227    Exit Sub
228
229HandleErrors:
230    ' MsgBox currentFunctionName & " : " & fileName & ": " & Err.Number & " " & Err.Description & " " & Err.Source
231    ' Handle Password error on Doc Open, Modify and Cancel
232    If Err.Number = 5408 Or Err.Number = 4198 Then
233        WriteDebug currentFunctionName & " : " & fileName & ": " & _
234            "User entered Invalid Document Password - " & Err.Number & " " & Err.Description & " " & Err.Source
235        HandleProtectedDocInvalidPassword mAnalysis, _
236            "User entered Invalid Document Password, further analysis not possible", fso
237        Resume FinalExit
238    ElseIf Err.Number = 5485 Then
239        ' Handle Password error on Unprotect Doc
240        WriteDebug currentFunctionName & " : " & fileName & ": " & _
241            "User entered Invalid Document Part Password, Analysis of doc will continue but will skip analysis of:" & _
242            "Forms, Comments, Headers & Footers and Table cell spanning issues - " & Err.Number & " " & Err.Description & " " & Err.Source
243        HandleProtectedDocInvalidPassword mAnalysis, _
244            "User entered Invalid Document Part Password, Analysis of doc will continue but will skip analysis of:" & vbLf & _
245            "Forms, Comments, Headers & Footers and Table cell spanning issues", fso
246        bUnprotectError = True
247        'wdAllowOnlyComments, wdAllowOnlyFormFields, wdAllowOnlyRevisions
248        Resume ContinueFromUnprotectError
249    End If
250    mAnalysis.Application = RID_STR_COMMON_CANNOT_OPEN
251    WriteDebug currentFunctionName & " : " & fileName & ": " & Err.Number & " " & Err.Description & " " & Err.Source
252    Resume FinalExit
253End Sub
254
255Sub DebugMacroInfo()
256    MsgBox "TotalNumLines: " & mAnalysis.MacroTotalNumLines & vbLf & _
257    "NumUserForms: " & mAnalysis.MacroNumUserForms & vbLf & _
258    "NumUserFormControls: " & mAnalysis.MacroNumUserFormControls & vbLf & _
259    "NumUserFormControlTypes: " & mAnalysis.MacroNumUserFormControlTypes & vbLf & _
260    "NumExternalRefs: " & mAnalysis.MacroNumExternalRefs & vbLf & _
261    "MacroNumFieldsUsingMacros: " & mAnalysis.MacroNumFieldsUsingMacros & vbLf & _
262    "NumOLEControls: " & mAnalysis.MacroNumOLEControls & vbLf & _
263    "MacroOverallClass: " & getDocOverallMacroClassAsString(mAnalysis.MacroOverallClass)
264End Sub
265
266Sub SetDocProperties(docAnalysis As DocumentAnalysis, doc As Document, fso As FileSystemObject)
267    On Error GoTo HandleErrors
268    Dim currentFunctionName As String
269    currentFunctionName = "SetProperties"
270    Dim f As File
271    Set f = fso.GetFile(docAnalysis.name)
272
273    docAnalysis.PageCount = doc.ComputeStatistics(wdStatisticPages)
274    docAnalysis.Accessed = f.DateLastAccessed
275
276    On Error Resume Next 'Some apps may not support all props
277    docAnalysis.Application = getAppSpecificApplicationName & " " & Application.Version
278    'docAnalysis.Application = doc.BuiltinDocumentProperties(wdPropertyAppName)
279    'If InStr(docAnalysis.Application, "Microsoft") = 1 Then
280    '    docAnalysis.Application = Mid(docAnalysis.Application, Len("Microsoft") + 2)
281    'End If
282    'If InStr(Len(docAnalysis.Application) - 2, docAnalysis.Application, ".") = 0 Then
283    '    docAnalysis.Application = docAnalysis.Application & " " & Application.Version
284    'End If
285
286    docAnalysis.Created = _
287        doc.BuiltInDocumentProperties(wdPropertyTimeCreated)
288    docAnalysis.Modified = _
289        doc.BuiltInDocumentProperties(wdPropertyTimeLastSaved)
290    docAnalysis.Printed = _
291        doc.BuiltInDocumentProperties(wdPropertyTimeLastPrinted)
292    docAnalysis.SavedBy = _
293        doc.BuiltInDocumentProperties(wdPropertyLastAuthor)
294    docAnalysis.Revision = _
295        val(doc.BuiltInDocumentProperties(wdPropertyRevision))
296    docAnalysis.Template = _
297        fso.GetFileName(doc.BuiltInDocumentProperties(wdPropertyTemplate))
298
299FinalExit:
300    Set f = Nothing
301    Exit Sub
302
303HandleErrors:
304    WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
305    Resume FinalExit
306End Sub
307
308'Limitation: Detect first level table in tables, does not detect further nesting
309'Can do so if required
310Sub Analyze_Tables_TablesInTables(currDoc As Document)
311    On Error GoTo HandleErrors
312    Dim currentFunctionName As String
313    currentFunctionName = "Analyze_Tables_TablesInTables"
314    Dim myTopTable As Table
315    Dim myInnerTable As Table
316    Dim myIssue As IssueInfo
317
318    For Each myTopTable In currDoc.Tables
319        For Each myInnerTable In myTopTable.Tables
320            Dim logString As String
321            Dim myRng As Range
322            Dim startpage As Long
323            Dim startRow As Long
324            Dim StartColumn As Long
325            Dim details As String
326
327            Set myIssue = New IssueInfo
328            Set myRng = myInnerTable.Range
329            myRng.start = myRng.End
330            startpage = myRng.Information(wdActiveEndPageNumber)
331            startRow = myRng.Information(wdStartOfRangeRowNumber)
332            StartColumn = myRng.Information(wdStartOfRangeColumnNumber)
333
334            With myIssue
335                .IssueID = CID_TABLES
336                .IssueType = RID_STR_WORD_ISSUE_TABLES
337                .SubType = RID_STR_WORD_SUBISSUE_NESTED_TABLES
338                .Location = .CLocationPage
339                .SubLocation = startpage
340
341                .IssueTypeXML = CSTR_ISSUE_TABLES
342                .SubTypeXML = CSTR_SUBISSUE_NESTED_TABLES
343                .locationXML = .CXMLLocationPage
344
345                .Attributes.Add RID_STR_WORD_ATTRIBUTE_OUTER_TABLE
346                .Values.Add myTopTable.Rows.count & "x" & myTopTable.Columns.count
347                .Attributes.Add RID_STR_WORD_ATTRIBUTE_INNER_TABLE
348                .Values.Add myInnerTable.Rows.count & "x" & myInnerTable.Columns.count
349                .Attributes.Add RID_STR_WORD_ATTRIBUTE_START_ROW
350                .Values.Add startRow
351                .Attributes.Add RID_STR_WORD_ATTRIBUTE_START_COL
352                .Values.Add StartColumn
353                AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_NESTED_TABLE_WILL_BE_LOST
354
355                mAnalysis.IssuesCountArray(CID_TABLES) = _
356                    mAnalysis.IssuesCountArray(CID_TABLES) + 1
357            End With
358
359            mAnalysis.Issues.Add myIssue
360            Set myIssue = Nothing
361            Set myRng = Nothing
362        Next
363    Next
364    Exit Sub
365HandleErrors:
366    WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
367End Sub
368
369Sub Analyze_Document_Protection(currDoc As Document)
370    On Error GoTo HandleErrors
371    Dim currentFunctionName As String
372    currentFunctionName = "Analyze_Document_Protection"
373    If currDoc.ProtectionType = wdNoProtection Then
374        Exit Sub
375    End If
376
377    Dim myIssue As IssueInfo
378    Set myIssue = New IssueInfo
379
380    With myIssue
381        .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES
382        .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES
383        .SubType = RID_STR_COMMON_SUBISSUE_DOCUMENT_PARTS_PROTECTION
384        .Location = .CLocationDocument
385
386        .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
387        .SubTypeXML = CSTR_SUBISSUE_DOCUMENT_PARTS_PROTECTION
388        .locationXML = .CXMLLocationDocument
389
390        .Attributes.Add RID_STR_WORD_ATTRIBUTE_PROTECTION
391        Select Case currDoc.ProtectionType
392            Case wdAllowOnlyComments
393                .Values.Add RID_STR_WORD_ATTRIBUTE_ALLOW_ONLY_COMMENTS
394            Case wdAllowOnlyFormFields
395                .Values.Add RID_STR_WORD_ATTRIBUTE_ALLOW_ONLY_FORM_FIELDS
396            Case wdAllowOnlyRevisions
397                .Values.Add RID_STR_WORD_ATTRIBUTE_ALLOW_ONLY_REVISIONS
398            Case Else
399                .Values.Add RID_STR_COMMON_ATTRIBUTE_UNKNOWN
400        End Select
401
402         mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _
403                mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1
404    End With
405
406    mAnalysis.Issues.Add myIssue
407FinalExit:
408    Set myIssue = Nothing
409    Exit Sub
410
411HandleErrors:
412    WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
413    Resume FinalExit
414End Sub
415
416Sub Analyze_Password_Protection(bHasPassword As Boolean, bWriteReserved As Boolean)
417    On Error GoTo HandleErrors
418    Dim currentFunctionName As String
419    currentFunctionName = "Analyze_Password_Protection"
420    Dim myIssue As IssueInfo
421
422    If bHasPassword Or bWriteReserved Then
423        Set myIssue = New IssueInfo
424
425        With myIssue
426            .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES
427            .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES
428            .SubType = RID_STR_COMMON_SUBISSUE_PASSWORDS_PROTECTION
429            .Location = .CLocationDocument
430
431            .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
432            .SubTypeXML = CSTR_SUBISSUE_PASSWORDS_PROTECTION
433            .locationXML = .CXMLLocationDocument
434
435            If bHasPassword Then
436                .Attributes.Add RID_STR_WORD_ATTRIBUTE_PASSWORD_TO_OPEN
437                .Values.Add RID_STR_WORD_ATTRIBUTE_SET
438            End If
439            If bWriteReserved Then
440                .Attributes.Add RID_STR_WORD_ATTRIBUTE_PASSWORD_TO_MODIFY
441                .Values.Add RID_STR_WORD_ATTRIBUTE_SET
442            End If
443
444            mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _
445                    mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1
446        End With
447
448        mAnalysis.Issues.Add myIssue
449    End If
450FinalExit:
451    Set myIssue = Nothing
452    Exit Sub
453
454HandleErrors:
455    WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
456    Resume FinalExit
457End Sub
458
459Sub Analyze_OLEEmbedded(currDoc As Document)
460    On Error GoTo HandleErrors
461    Dim currentFunctionName As String
462    currentFunctionName = "Analyze_OLEEmbedded"
463
464    ' Handle Inline Shapes
465    Dim aILShape As InlineShape
466    For Each aILShape In currDoc.InlineShapes
467        Analyze_OLEEmbeddedSingleInlineShape aILShape
468    Next aILShape
469
470    ' Handle Shapes
471    Dim aShape As Shape
472    For Each aShape In currDoc.Shapes
473        Analyze_OLEEmbeddedSingleShape mAnalysis, aShape, _
474            Selection.Information(wdActiveEndPageNumber)
475        Analyze_Lines mAnalysis, aShape, _
476            Selection.Information(wdActiveEndPageNumber)
477        Analyze_Transparency mAnalysis, aShape, _
478            Selection.Information(wdActiveEndPageNumber)
479        Analyze_Gradients mAnalysis, aShape, _
480            Selection.Information(wdActiveEndPageNumber)
481    Next aShape
482
483    Exit Sub
484
485HandleErrors:
486    WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
487End Sub
488
489
490'WdInlineShapeType constants:
491'wdInlineShapeEmbeddedOLEObject, wdInlineShapeHorizontalLine, wdInlineShapeLinkedOLEObject,
492'wdInlineShapeLinkedPicture, wdInlineShapeLinkedPictureHorizontalLine, wdInlineShapeOLEControlObject,
493'wdInlineShapeOWSAnchor, wdInlineShapePicture, wdInlineShapePictureBullet,
494'wdInlineShapePictureHorizontalLine, wdInlineShapeScriptAnchor
495
496Sub Analyze_OLEEmbeddedSingleInlineShape(aILShape As InlineShape)
497    On Error GoTo HandleErrors
498    Dim currentFunctionName As String
499    currentFunctionName = "Analyze_OLEEmbeddedSingleInlineShape"
500    Dim myIssue As IssueInfo
501    Dim bOleObject As Boolean
502    Dim TypeAsString As String
503    Dim XMLTypeAsString As String
504    Dim objName As String
505
506    bOleObject = (aILShape.Type = wdInlineShapeEmbeddedOLEObject) Or _
507                    (aILShape.Type = wdInlineShapeLinkedOLEObject) Or _
508                    (aILShape.Type = wdInlineShapeOLEControlObject)
509
510    If Not bOleObject Then Exit Sub
511
512    aILShape.Select
513    Select Case aILShape.Type
514        Case wdInlineShapeOLEControlObject
515            TypeAsString = RID_STR_COMMON_OLE_CONTROL
516            XMLTypeAsString = CSTR_SUBISSUE_OLE_CONTROL
517        Case wdInlineShapeEmbeddedOLEObject
518            TypeAsString = RID_STR_COMMON_OLE_EMBEDDED
519            XMLTypeAsString = CSTR_SUBISSUE_OLE_EMBEDDED
520        Case wdInlineShapeLinkedOLEObject
521            TypeAsString = RID_STR_COMMON_OLE_LINKED
522            XMLTypeAsString = CSTR_SUBISSUE_OLE_LINKED
523        Case Else
524            TypeAsString = RID_STR_COMMON_OLE_UNKNOWN
525            XMLTypeAsString = CSTR_SUBISSUE_OLE_UNKNOWN
526    End Select
527
528    Set myIssue = New IssueInfo
529    With myIssue
530        .IssueID = CID_PORTABILITY
531        .IssueType = RID_STR_COMMON_ISSUE_PORTABILITY
532        .SubType = TypeAsString
533        .Location = .CLocationPage
534        .SubLocation = Selection.Information(wdActiveEndPageNumber)
535
536        .IssueTypeXML = CSTR_ISSUE_PORTABILITY
537        .SubTypeXML = XMLTypeAsString
538        .locationXML = .CXMLLocationPage
539
540        .Line = Selection.Information(wdFirstCharacterLineNumber)
541        .column = Selection.Information(wdFirstCharacterColumnNumber)
542
543        DoEvents
544        If aILShape.Type = wdInlineShapeEmbeddedOLEObject Or _
545           aILShape.Type = wdInlineShapeOLEControlObject Then
546
547            'If Object is invalid can get automation server hanging
548            Dim tmpStr As String
549            On Error Resume Next
550            tmpStr = aILShape.OLEFormat.Object
551            If Err.Number = 0 Then
552                .Attributes.Add RID_STR_COMMON_ATTRIBUTE_OBJECT_TYPE
553                .Values.Add aILShape.OLEFormat.ProgID
554            Else
555                Err.Clear
556                tmpStr = aILShape.OLEFormat.ClassType
557                If Err.Number = 0 Then
558                    .Attributes.Add RID_STR_COMMON_ATTRIBUTE_OBJECT_TYPE
559                    .Values.Add aILShape.OLEFormat.ClassType
560                Else
561                    .Attributes.Add RID_STR_COMMON_ATTRIBUTE_OBJECT_TYPE
562                    .Values.Add RID_STR_COMMON_NA
563                End If
564            End If
565
566            If aILShape.Type = wdInlineShapeOLEControlObject Then
567                mAnalysis.MacroNumOLEControls = 1 + mAnalysis.MacroNumOLEControls
568            End If
569
570            objName = aILShape.OLEFormat.Object.name
571            If Err.Number = 0 Then
572                .Attributes.Add RID_STR_COMMON_ATTRIBUTE_OBJECT_NAME
573                .Values.Add objName
574            End If
575            On Error GoTo HandleErrors
576        End If
577        If aILShape.Type = wdInlineShapeLinkedOLEObject Then
578            .Attributes.Add RID_STR_COMMON_ATTRIBUTE_SOURCE
579            .Values.Add aILShape.LinkFormat.SourceFullName
580        End If
581
582        mAnalysis.IssuesCountArray(CID_PORTABILITY) = _
583            mAnalysis.IssuesCountArray(CID_PORTABILITY) + 1
584    End With
585
586    mAnalysis.Issues.Add myIssue
587
588FinalExit:
589    Set myIssue = Nothing
590    Exit Sub
591
592HandleErrors:
593    WriteDebugLevelTwo currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
594    Resume FinalExit
595End Sub
596
597'Appears to be picked up by other OLE analysis code - the Shapes are actually field codes
598'So I get double reporting if I use this as well.
599Sub Analyze_OLEFields(myField As Field)
600    On Error GoTo HandleErrors
601    Dim currentFunctionName As String
602    currentFunctionName = "Analyze_OLEFields"
603    Dim myIssue As IssueInfo
604    Dim bOleObject As Boolean
605    Dim TypeAsString As String
606    Dim XMLTypeAsString As String
607
608    bOleObject = (myField.Type = wdFieldOCX)
609
610    If Not bOleObject Then Exit Sub
611
612    myField.Select
613    Select Case myField.Type
614        Case wdFieldLink
615            TypeAsString = RID_STR_COMMON_OLE_FIELD_LINK
616            XMLTypeAsString = CSTR_SUBISSUE_OLE_FIELD_LINK
617        Case Else
618            TypeAsString = RID_STR_COMMON_OLE_UNKNOWN
619            XMLTypeAsString = CSTR_SUBISSUE_OLE_UNKNOWN
620    End Select
621    Set myIssue = New IssueInfo
622    With myIssue
623        .IssueID = CID_PORTABILITY
624        .IssueType = RID_STR_COMMON_ISSUE_PORTABILITY
625        .SubType = TypeAsString
626        .Location = .CLocationPage
627        .SubLocation = Selection.Information(wdActiveEndPageNumber)
628
629        .IssueTypeXML = CSTR_ISSUE_PORTABILITY
630        .SubTypeXML = XMLTypeAsString
631        .locationXML = .CXMLLocationPage
632
633        .Line = Selection.Information(wdFirstCharacterLineNumber)
634        .column = Selection.Information(wdFirstCharacterColumnNumber)
635        .Attributes.Add RID_STR_COMMON_ATTRIBUTE_OBJECT_TYPE
636        .Values.Add myField.OLEFormat.ClassType
637
638        If myField.Type = wdFieldLink Then
639            .Attributes.Add RID_STR_WORD_ATTRIBUTE_LINK
640            .Values.Add myField.LinkFormat.SourceFullName
641        End If
642        mAnalysis.IssuesCountArray(CID_PORTABILITY) = _
643            mAnalysis.IssuesCountArray(CID_PORTABILITY) + 1
644    End With
645    mAnalysis.Issues.Add myIssue
646
647    Set myIssue = Nothing
648
649    Exit Sub
650
651HandleErrors:
652    Set myIssue = Nothing
653    WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
654End Sub
655
656Sub Analyze_MailMergeField(myField As Field)
657    On Error GoTo HandleErrors
658    Dim currentFunctionName As String
659    currentFunctionName = "Analyze_MailMergeField"
660    Dim myIssue As IssueInfo
661    Dim TypeAsString As String
662    Dim bProblemMailMergeField As Boolean
663
664    bProblemMailMergeField = _
665        (myField.Type = wdFieldFillIn) Or _
666        (myField.Type = wdFieldAsk) Or _
667        (myField.Type = wdFieldMergeRec) Or _
668        (myField.Type = wdFieldMergeField) Or _
669        (myField.Type = wdFieldNext) Or _
670        (myField.Type = wdFieldRevisionNum) Or _
671        (myField.Type = wdFieldSequence) Or _
672        (myField.Type = wdFieldAutoNum) Or _
673        (myField.Type = wdFieldAutoNumOutline) Or _
674        (myField.Type = wdFieldAutoNumLegal)
675
676    If bProblemMailMergeField Then
677    'Some of the following are numbering fields and need to be broken out into a separate function. See migration guide.
678
679        Select Case myField.Type
680        Case wdFieldFillIn
681            TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_FILL_IN
682        Case wdFieldAsk
683            TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_ASK
684        Case wdFieldMergeRec
685            TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_MERGE_RECORDS
686        Case wdFieldMergeField
687            TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_MERGE_FIELDS
688        Case wdFieldNext
689            TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_NEXT
690        Case wdFieldRevisionNum
691            TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_REVISION_NUMBER
692        Case wdFieldSequence
693            TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_SEQUENCE
694        Case wdFieldAutoNum
695            TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_AUTO_NUMBER
696        Case wdFieldAutoNumOutline
697            TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_AUTO_NUMBER_OUTLINE
698        Case wdFieldAutoNumLegal
699            TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_AUTO_NUMBER_LEGAL
700        Case Else
701            TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_FIELD_NAME_NOT_KNOWN
702        End Select
703
704        Set myIssue = New IssueInfo
705        myField.Select
706        With myIssue
707            .IssueID = CID_FIELDS
708            .IssueType = RID_STR_WORD_ISSUE_FIELDS
709            .SubType = RID_STR_WORD_SUBISSUE_MAILMERGE_FIELD
710            .Location = .CLocationPage
711
712            .IssueTypeXML = CSTR_ISSUE_FIELDS
713            .SubTypeXML = CSTR_SUBISSUE_MAILMERGE_FIELD
714            .locationXML = .CXMLLocationPage
715
716            .SubLocation = Selection.Information(wdActiveEndPageNumber)
717            .Line = Selection.Information(wdFirstCharacterLineNumber)
718            .column = Selection.Information(wdFirstCharacterColumnNumber)
719
720            .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME
721            .Values.Add TypeAsString
722            If myField.Code.Text <> "" Then
723                .Attributes.Add RID_STR_WORD_ATTRIBUTE_TEXT
724                .Values.Add myField.Code.Text
725            End If
726
727            mAnalysis.IssuesCountArray(CID_FIELDS) = _
728                mAnalysis.IssuesCountArray(CID_FIELDS) + 1
729        End With
730        mAnalysis.Issues.Add myIssue
731        Set myIssue = Nothing
732    End If
733    Exit Sub
734
735HandleErrors:
736    WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
737End Sub
738
739'Get field DS Info
740Sub Analyze_MailMerge_DataSource(currDoc As Document)
741    On Error GoTo HandleErrors
742    Dim currentFunctionName As String
743    currentFunctionName = "Analyze_MailMerge_DataSource"
744    ' There may be no mail merge in the document
745    If (currDoc.MailMerge.DataSource.Type = wdNoMergeInfo) Then
746        Exit Sub
747    End If
748
749    'Dim issue As SimpleAnalysisInfo
750    If (currDoc.MailMerge.DataSource.Type <> wdNoMergeInfo) Then
751        Dim myIssue As IssueInfo
752        Set myIssue = New IssueInfo
753        With myIssue
754            .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES
755            .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES
756            .SubType = RID_STR_WORD_SUBISSUE_MAILMERGE_DATASOURCE
757            .Location = .CLocationDocument
758
759            .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
760            .SubTypeXML = CSTR_SUBISSUE_MAILMERGE_DATASOURCE
761            .locationXML = .CXMLLocationDocument
762
763            .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME
764            .Values.Add currDoc.MailMerge.DataSource.name
765            .Attributes.Add RID_STR_WORD_ATTRIBUTE_DATASOURCE
766            .Values.Add currDoc.MailMerge.DataSource.Type
767
768            mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _
769                mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1
770        End With
771
772        mAnalysis.Issues.Add myIssue
773        Set myIssue = Nothing
774   End If
775   Exit Sub
776
777HandleErrors:
778    WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
779End Sub
780
781Function getFormFieldTypeAsString(fieldType As WdFieldType)
782    Dim Str As String
783
784    Select Case fieldType
785    Case wdFieldFormCheckBox
786        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_CHECK_BOX
787    Case wdFieldFormDropDown
788        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DROP_DOWN
789    Case wdFieldFormTextInput
790        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_TEXT
791    Case Else
792        Str = RID_STR_WORD_ENUMERATION_UNKNOWN
793    End Select
794
795    getFormFieldTypeAsString = Str
796End Function
797Function getTextFormFieldTypeAsString(fieldType As WdTextFormFieldType)
798    Dim Str As String
799
800    Select Case fieldType
801    Case wdCalculationText
802        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_CALCULATION
803    Case wdCurrentDateText
804        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_CURRENT_DATE
805    Case wdCurrentTimeText
806        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_CURRENT_TIME
807    Case wdDateText
808        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DATE
809    Case wdNumberText
810        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_NUMBER
811    Case wdRegularText
812        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_REGULAR
813    Case Else
814        Str = RID_STR_WORD_ENUMERATION_UNKNOWN
815    End Select
816
817    getTextFormFieldTypeAsString = Str
818End Function
819Function getTextFormFieldDefaultAsString(fieldType As WdTextFormFieldType)
820    Dim Str As String
821
822    Select Case fieldType
823    Case wdCalculationText
824        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DEFAULT_EXPRESSION
825    Case wdCurrentDateText
826        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DEFAULT_DATE
827    Case wdCurrentTimeText
828        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DEFAULT_TIME
829    Case wdDateText
830        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DEFAULT_DATE
831    Case wdNumberText
832        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DEFAULT_NUMBER
833    Case wdRegularText
834        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DEFAULT_TEXT
835    Case Else
836        Str = RID_STR_WORD_ENUMERATION_UNKNOWN
837    End Select
838
839    getTextFormFieldDefaultAsString = Str
840End Function
841Function getTextFormFieldFormatAsString(fieldType As WdTextFormFieldType)
842    Dim Str As String
843
844    Select Case fieldType
845    Case wdCalculationText
846        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_FORMAT_NUMBER
847    Case wdCurrentDateText
848        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_FORMAT_DATE
849    Case wdCurrentTimeText
850        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_FORMAT_TIME
851    Case wdDateText
852        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_FORMAT_DATE
853    Case wdNumberText
854        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_FORMAT_NUMBER
855    Case wdRegularText
856        Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_FORMAT_TEXT
857    Case Else
858        Str = RID_STR_WORD_ENUMERATION_UNKNOWN
859    End Select
860
861    getTextFormFieldFormatAsString = Str
862End Function
863
864Sub Analyze_FieldAndFormFieldIssues(currDoc As Document)
865    On Error GoTo HandleErrors
866    Dim currentFunctionName As String
867    currentFunctionName = "Analyze_FormFields"
868    Dim myIssue As IssueInfo
869
870    'Analysze all Fields in doc
871    Dim myField As Field
872
873    For Each myField In currDoc.Fields
874        'Analyze Mail Merge Fields
875        Analyze_MailMergeField myField
876
877        'Analyze TOA Fields
878        Analyze_TOAField myField
879    Next myField
880
881    'Analyze FormField doc issues
882    If currDoc.FormFields.count = 0 Then GoTo FinalExit
883
884    If (currDoc.FormFields.Shaded) Then
885        Set myIssue = New IssueInfo
886        With myIssue
887            .IssueID = CID_FIELDS
888            .IssueType = RID_STR_WORD_ISSUE_FIELDS
889            .SubType = RID_STR_WORD_SUBISSUE_APPEARANCE
890            .Location = .CLocationDocument
891
892            .IssueTypeXML = CSTR_ISSUE_FIELDS
893            .SubTypeXML = CSTR_SUBISSUE_APPEARANCE
894            .locationXML = .CXMLLocationDocument
895
896            .Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_GREYED
897            .Values.Add RID_STR_WORD_TRUE
898            mAnalysis.IssuesCountArray(CID_FIELDS) = _
899                mAnalysis.IssuesCountArray(CID_FIELDS) + 1
900        End With
901        mAnalysis.Issues.Add myIssue
902        Set myIssue = Nothing
903    End If
904
905    'Analyse all FormFields in doc
906    Dim myFormField As FormField
907
908    For Each myFormField In currDoc.FormFields
909        Analyze_FormFieldIssue myFormField
910    Next myFormField
911
912FinalExit:
913    Set myIssue = Nothing
914    Set myFormField = Nothing
915    Exit Sub
916
917HandleErrors:
918
919    WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
920    Resume FinalExit
921End Sub
922
923Sub Analyze_FormFieldIssue(myFormField As FormField)
924    On Error GoTo HandleErrors
925    Dim currentFunctionName As String
926    currentFunctionName = "Analyze_FormFieldIssue"
927    Dim myIssue As IssueInfo
928    Dim bCheckBoxIssues As Boolean
929    Dim bFormFieldIssues As Boolean
930
931    bCheckBoxIssues = False
932    If (myFormField.Type = wdFieldFormCheckBox) Then
933        If myFormField.CheckBox.AutoSize Then
934            bCheckBoxIssues = True
935        End If
936    End If
937
938    bFormFieldIssues = bCheckBoxIssues
939
940    If Not bFormFieldIssues Then GoTo FinalExit
941
942    myFormField.Select
943    Set myIssue = New IssueInfo
944    With myIssue
945        .IssueID = CID_FIELDS
946        .IssueType = RID_STR_WORD_ISSUE_FIELDS
947        .SubType = RID_STR_WORD_SUBISSUE_FORM_FIELD
948        .Location = .CLocationPage
949
950        .IssueTypeXML = CSTR_ISSUE_FIELDS
951        .SubTypeXML = CSTR_SUBISSUE_FORM_FIELD
952        .locationXML = .CXMLLocationPage
953
954        .SubLocation = Selection.Information(wdActiveEndPageNumber)
955        .Line = Selection.Information(wdFirstCharacterLineNumber)
956        .column = Selection.Information(wdFirstCharacterColumnNumber)
957        myIssue.Attributes.Add RID_STR_COMMON_ATTRIBUTE_TYPE
958        myIssue.Values.Add getFormFieldTypeAsString(myFormField.Type)
959    End With
960
961    'Checkbox Issues
962    If (myFormField.Type = wdFieldFormCheckBox) Then
963       'AutoSize CheckBoxes
964        If myFormField.CheckBox.AutoSize Then
965            myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_AUTOSIZE
966            myIssue.Values.Add RID_STR_WORD_TRUE
967        End If
968    End If
969
970    'TextInput Issues
971    If myFormField.Type = wdFieldFormTextInput Then
972        myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_TEXT_FORM_FIELD_TYPE
973        myIssue.Values.Add getTextFormFieldTypeAsString(myFormField.TextInput.Type)
974        Dim bLostType As Boolean
975        bLostType = False
976        If (myFormField.TextInput.Type = wdCalculationText) Or _
977            (myFormField.TextInput.Type = wdCurrentDateText) Or _
978            (myFormField.TextInput.Type = wdCurrentTimeText) Then
979            AddIssueDetailsNote myIssue, 0, getTextFormFieldTypeAsString(myFormField.TextInput.Type) & _
980            " " & RID_STR_WORD_NOTE_FORM_FIELD_TYPE_LOST
981            bLostType = True
982        End If
983
984        If (myFormField.TextInput.Format <> "") Then
985            myIssue.Attributes.Add getTextFormFieldFormatAsString(myFormField.TextInput.Type)
986            myIssue.Values.Add myFormField.TextInput.Format
987        End If
988
989       'Default text
990        If (myFormField.TextInput.Default <> "") Then
991            myIssue.Attributes.Add getTextFormFieldDefaultAsString(myFormField.TextInput.Type)
992            myIssue.Values.Add myFormField.TextInput.Default
993        End If
994
995       'Maximum text
996        If (myFormField.TextInput.Width <> 0) Then
997            myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_MAX_LENGTH
998            myIssue.Values.Add myFormField.TextInput.Width
999        End If
1000
1001        'Fill-in disabled
1002        If (myFormField.Enabled = False) And (Not bLostType) Then
1003            myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_FILLIN_ENABLED
1004            myIssue.Values.Add RID_STR_WORD_FALSE
1005        End If
1006    End If
1007
1008    'Help Key(F1)
1009    If (myFormField.OwnHelp And myFormField.HelpText <> "") Then
1010        myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_HELP_KEY_F1_OWN_TEXT
1011        myIssue.Values.Add myFormField.HelpText
1012    ElseIf ((Not myFormField.OwnHelp) And myFormField.HelpText <> "") Then
1013        myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_HELP_KEY_F1_AUTO_TEXT
1014        myIssue.Values.Add myFormField.HelpText
1015    End If
1016
1017    'StatusHelp
1018    If (myFormField.OwnStatus And myFormField.StatusText <> "") Then
1019        myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_STATUS_BAR_HELP_OWN_TEXT
1020        myIssue.Values.Add myFormField.StatusText
1021    ElseIf ((Not myFormField.OwnStatus) And myFormField.StatusText <> "") Then
1022        myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_STATUS_BAR_HELP_AUTO_TEXT
1023        myIssue.Values.Add myFormField.StatusText
1024    End If
1025
1026    'Macros
1027    If (myFormField.EntryMacro <> "") Then
1028        myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_ENTRY_MACRO
1029        myIssue.Values.Add myFormField.EntryMacro
1030    End If
1031    If (myFormField.ExitMacro <> "") Then
1032        myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_EXIT_MACRO
1033        myIssue.Values.Add myFormField.ExitMacro
1034    End If
1035    If (myFormField.EntryMacro <> "") Or (myFormField.ExitMacro <> "") Then
1036        mAnalysis.MacroNumFieldsUsingMacros = 1 + mAnalysis.MacroNumFieldsUsingMacros
1037    End If
1038
1039    'LockedField
1040    If (myFormField.Enabled = False) And (myFormField.Type <> wdFieldFormTextInput) Then
1041        myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_LOCKED
1042        myIssue.Values.Add RID_STR_WORD_TRUE
1043    End If
1044
1045    mAnalysis.IssuesCountArray(CID_FIELDS) = _
1046        mAnalysis.IssuesCountArray(CID_FIELDS) + 1
1047
1048    mAnalysis.Issues.Add myIssue
1049
1050FinalExit:
1051    Set myIssue = Nothing
1052    Exit Sub
1053
1054HandleErrors:
1055    'Log first occurrence for this doc
1056    If Not mbFormFieldErrorLogged Then
1057        WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
1058        mbFormFieldErrorLogged = True
1059    End If
1060    Resume FinalExit
1061End Sub
1062
1063
1064Sub Analyze_TOA(currDoc As Document)
1065    On Error GoTo HandleErrors
1066    Dim currentFunctionName As String
1067    currentFunctionName = "Analyze_TOA"
1068
1069    Dim toa As TableOfAuthorities
1070    Dim myIssue As IssueInfo
1071    Dim myRng As Range
1072
1073    For Each toa In currDoc.TablesOfAuthorities
1074        Set myRng = toa.Range
1075        myRng.start = myRng.End
1076        Set myIssue = New IssueInfo
1077        myRng.Select
1078
1079        Dim TabLeaderAsString As String
1080        Select Case toa.TabLeader
1081            Case wdTabLeaderDashes
1082                TabLeaderAsString = RID_STR_WORD_ENUMERATION_INDEX_LEADER_DASHES
1083            Case wdTabLeaderDots
1084                TabLeaderAsString = RID_STR_WORD_ENUMERATION_INDEX_LEADER_DOTS
1085            Case wdTabLeaderHeavy
1086                TabLeaderAsString = RID_STR_WORD_ENUMERATION_INDEX_LEADER_HEAVY
1087            Case wdTabLeaderLines
1088                TabLeaderAsString = RID_STR_WORD_ENUMERATION_INDEX_LEADER_LINES
1089            Case wdTabLeaderMiddleDot
1090                TabLeaderAsString = RID_STR_WORD_ENUMERATION_INDEX_LEADER_MIDDLEDOT
1091            Case wdTabLeaderSpaces
1092                TabLeaderAsString = RID_STR_WORD_ENUMERATION_INDEX_LEADER_SPACES
1093            Case Else
1094                TabLeaderAsString = RID_STR_WORD_ENUMERATION_UNKNOWN
1095        End Select
1096
1097        Dim FormatAsString As String
1098        Select Case currDoc.TablesOfAuthorities.Format
1099            Case wdTOAClassic
1100                FormatAsString = RID_STR_WORD_ENUMERATION_INDEX_TABLES_CLASSIC
1101            Case wdTOADistinctive
1102                FormatAsString = RID_STR_WORD_ENUMERATION_INDEX_TABLES_DISTINCTIVE
1103            Case wdTOAFormal
1104                FormatAsString = RID_STR_WORD_ENUMERATION_INDEX_TABLES_FORMAL
1105            Case wdTOASimple
1106                FormatAsString = RID_STR_WORD_ENUMERATION_INDEX_TABLES_SIMPLE
1107            Case wdTOATemplate
1108                FormatAsString = RID_STR_WORD_ENUMERATION_INDEX_TABLES_FROM_TEMPLATE
1109            Case Else
1110                FormatAsString = RID_STR_WORD_ENUMERATION_UNKNOWN
1111        End Select
1112
1113        With myIssue
1114            .IssueID = CID_INDEX_AND_REFERENCES
1115            .IssueType = RID_STR_WORD_ISSUE_INDEX_AND_REFERENCES
1116            .SubType = RID_STR_WORD_SUBISSUE_TABLE_OF_AUTHORITIES
1117            .Location = .CLocationPage
1118
1119            .IssueTypeXML = CSTR_ISSUE_INDEX_AND_REFERENCES
1120            .SubTypeXML = CSTR_SUBISSUE_TABLE_OF_AUTHORITIES
1121            .locationXML = .CXMLLocationPage
1122
1123            .SubLocation = myRng.Information(wdActiveEndPageNumber)
1124            .Attributes.Add RID_STR_WORD_ATTRIBUTE_LEADER
1125            .Values.Add TabLeaderAsString
1126
1127            AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_TOA_MIGRATE_AS_PLAIN_TEXT
1128
1129            mAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) = _
1130                mAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) + 1
1131        End With
1132
1133        mAnalysis.Issues.Add myIssue
1134        Set myIssue = Nothing
1135        Set myRng = Nothing
1136    Next
1137FinalExit:
1138    Set myIssue = Nothing
1139    Set myRng = Nothing
1140    Exit Sub
1141
1142HandleErrors:
1143    WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
1144    Resume FinalExit
1145End Sub
1146
1147Sub Analyze_TOAField(myField As Field)
1148    On Error GoTo HandleErrors
1149    Dim currentFunctionName As String
1150    currentFunctionName = "Analyze_TOAField"
1151
1152    Dim toa As TableOfAuthorities
1153    Dim myIssue As IssueInfo
1154
1155    If myField.Type = wdFieldTOAEntry Then
1156        Set myIssue = New IssueInfo
1157        myField.Select
1158
1159        With myIssue
1160            .IssueID = CID_FIELDS
1161            .IssueType = RID_STR_WORD_ISSUE_FIELDS
1162            .SubType = RID_STR_WORD_SUBISSUE_TABLE_OF_AUTHORITIES_FIELD
1163            .Location = .CLocationPage
1164
1165            .IssueTypeXML = CSTR_ISSUE_FIELDS
1166            .SubTypeXML = CSTR_SUBISSUE_TABLE_OF_AUTHORITIES_FIELD
1167            .locationXML = .CXMLLocationPage
1168
1169            .SubLocation = Selection.Information(wdActiveEndPageNumber)
1170            .Line = Selection.Information(wdFirstCharacterLineNumber)
1171            .column = Selection.Information(wdFirstCharacterColumnNumber)
1172
1173            .Attributes.Add RID_STR_WORD_ATTRIBUTE_FIELD_TEXT
1174            .Values.Add myField.Code.Text
1175
1176            AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_TOA_FIELD_LOST_ON_ROUNDTRIP
1177
1178            mAnalysis.IssuesCountArray(CID_FIELDS) = _
1179                mAnalysis.IssuesCountArray(CID_FIELDS) + 1
1180        End With
1181
1182        mAnalysis.Issues.Add myIssue
1183        Set myIssue = Nothing
1184    End If
1185
1186FinalExit:
1187    Set myIssue = Nothing
1188    Exit Sub
1189
1190HandleErrors:
1191    WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
1192    Resume FinalExit
1193End Sub
1194
1195Sub Analyze_Tables_Borders(currDoc As Document)
1196    On Error GoTo HandleErrors
1197    Dim currentFunctionName As String
1198    currentFunctionName = "Analyze_Tables_Borders"
1199    Dim myIssue As IssueInfo
1200    Set myIssue = New IssueInfo
1201    Dim aTable As Table
1202    Dim invalidBorders As String
1203
1204    For Each aTable In currDoc.Tables
1205        invalidBorders = GetInvalidBorder(aTable)
1206        If invalidBorders <> "" Then
1207            aTable.Range.Select
1208            Set myIssue = New IssueInfo
1209            With myIssue
1210                .IssueID = CID_TABLES
1211                .IssueType = RID_STR_WORD_ISSUE_TABLES
1212                .SubType = RID_STR_WORD_SUBISSUE_BORDER_STYLES
1213                .Location = .CLocationPage
1214
1215                .IssueTypeXML = CSTR_ISSUE_TABLES
1216                .SubTypeXML = CSTR_SUBISSUE_BORDER_STYLES
1217                .locationXML = .CXMLLocationPage
1218
1219                .SubLocation = Selection.Information(wdActiveEndPageNumber)
1220                .Line = Selection.Information(wdFirstCharacterLineNumber)
1221                .column = Selection.Information(wdFirstCharacterColumnNumber)
1222
1223                .Attributes.Add RID_STR_WORD_ATTRIBUTE_BORDERS_NOT_DISPLAYING
1224                .Values.Add invalidBorders
1225
1226                AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_TABLE_BORDER
1227
1228                mAnalysis.IssuesCountArray(CID_TABLES) = mAnalysis.IssuesCountArray(CID_TABLES) + 1
1229            End With
1230
1231            mAnalysis.Issues.Add myIssue
1232            Set myIssue = Nothing
1233        End If
1234    Next aTable
1235FinalExit:
1236    Set myIssue = Nothing
1237    Exit Sub
1238
1239HandleErrors:
1240    WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
1241    Resume FinalExit
1242End Sub
1243Function GetInvalidBorder(aTable As Table) As String
1244
1245    Dim theResult As String
1246    theResult = ""
1247
1248    If IsInvalidBorderStyle(aTable.Borders(wdBorderTop).LineStyle) Then
1249        theResult = theResult + "Top, "
1250    End If
1251    If IsInvalidBorderStyle(aTable.Borders(wdBorderBottom).LineStyle) Then
1252            theResult = theResult + "Bottom, "
1253    End If
1254    If IsInvalidBorderStyle(aTable.Borders(wdBorderDiagonalDown).LineStyle) Then
1255            theResult = theResult + "Down Diagonal, "
1256    End If
1257    If IsInvalidBorderStyle(aTable.Borders(wdBorderDiagonalUp).LineStyle) Then
1258            theResult = theResult + "Up Diagonal, "
1259
1260    End If
1261    If IsInvalidBorderStyle(aTable.Borders(wdBorderHorizontal).LineStyle) Then
1262            theResult = theResult + "Horizontal, "
1263    End If
1264    If IsInvalidBorderStyle(aTable.Borders(wdBorderLeft).LineStyle) Then
1265            theResult = theResult + "Left, "
1266    End If
1267    If IsInvalidBorderStyle(aTable.Borders(wdBorderRight).LineStyle) Then
1268            theResult = theResult + "Right, "
1269    End If
1270    If IsInvalidBorderStyle(aTable.Borders(wdBorderVertical).LineStyle) Then
1271            theResult = theResult + "Vertical, "
1272    End If
1273
1274    If theResult <> "" Then
1275        theResult = Left(theResult, (Len(theResult) - 2)) + "."
1276    End If
1277
1278    GetInvalidBorder = theResult
1279End Function
1280
1281Function IsInvalidBorderStyle(aStyle As WdLineStyle) As Boolean
1282
1283    Dim IsInvalid As Boolean
1284
1285    Select Case aStyle
1286    Case wdLineStyleDot, wdLineStyleDashSmallGap, wdLineStyleDashLargeGap, wdLineStyleDashDot, _
1287        wdLineStyleDashDotDot, wdLineStyleTriple, wdLineStyleThinThickThinSmallGap, wdLineStyleThinThickMedGap, _
1288        wdLineStyleThickThinMedGap, wdLineStyleThinThickThinMedGap, wdLineStyleThinThickLargeGap, _
1289        wdLineStyleThickThinLargeGap, wdLineStyleThinThickThinLargeGap, wdLineStyleSingleWavy, _
1290        wdLineStyleDoubleWavy, wdLineStyleDashDotStroked, wdLineStyleEmboss3D, wdLineStyleEngrave3D
1291        IsInvalid = True
1292    Case Else
1293        IsInvalid = False
1294    End Select
1295
1296    IsInvalidBorderStyle = IsInvalid
1297
1298End Function
1299
1300Private Sub Class_Initialize()
1301    Set mAnalysis = New DocumentAnalysis
1302End Sub
1303Private Sub Class_Terminate()
1304    Set mAnalysis = Nothing
1305End Sub
1306
1307Public Property Get Results() As DocumentAnalysis
1308    Set Results = mAnalysis
1309End Property
1310
1311Sub Analyze_NumberingTabs(currDoc As Document, docAnalysis As DocumentAnalysis)
1312    On Error GoTo HandleErrors
1313    Dim currentFunctionName As String
1314    currentFunctionName = "Analyze_NumberingTabs"
1315
1316    Dim tb As TabStop
1317    Dim customTabPos As Single
1318    Dim tabs As Integer
1319    Dim listLvl As Long
1320    Dim tp As Single
1321    Dim bHasAlignmentProblem As Boolean
1322    Dim bHasTooManyTabs As Boolean
1323    Dim myIssue As IssueInfo
1324    Dim p As Object
1325
1326    bHasAlignmentProblem = False
1327    bHasTooManyTabs = False
1328
1329    For Each p In currDoc.ListParagraphs
1330        tabs = 0
1331        For Each tb In p.TabStops
1332            If tb.customTab Then
1333                tabs = tabs + 1
1334                customTabPos = tb.Position
1335            End If
1336        Next
1337
1338        If tabs = 1 Then
1339            listLvl = p.Range.ListFormat.ListLevelNumber
1340            tp = p.Range.ListFormat.ListTemplate.ListLevels.item(listLvl).TabPosition
1341            If (p.Range.ListFormat.ListTemplate.ListLevels.item(listLvl).Alignment <> _
1342                wdListLevelAlignLeft) Then
1343                ' ERROR: alignment problem
1344                bHasAlignmentProblem = True
1345            End If
1346
1347            If tp <> customTabPos Then
1348                p.Range.InsertBefore ("XXXXX")
1349            End If
1350            'OK - at least heuristically
1351        Else
1352            'ERROR: too many tabs
1353            bHasTooManyTabs = True
1354        End If
1355    Next
1356
1357    If (bHasAlignmentProblem) Then
1358        Set myIssue = New IssueInfo
1359
1360        With myIssue
1361            .IssueID = CID_INDEX_AND_REFERENCES
1362            .IssueType = RID_STR_WORD_ISSUE_INDEX_AND_REFERENCES
1363            .SubType = RID_STR_WORD_SUBISSUE_NUMBERING_TAB_ALIGNMENT
1364            .Location = .CLocationDocument 'Location string
1365
1366            .IssueTypeXML = CSTR_ISSUE_INDEX_AND_REFERENCES
1367            .SubTypeXML = CSTR_SUBISSUE_NUMBERING_TAB_ALIGNMENT
1368            .locationXML = .CXMLLocationDocument
1369
1370            AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_NUMBERING_TAB_ALIGNMENT
1371
1372            docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) = _
1373                    docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) + 1
1374        End With
1375        docAnalysis.Issues.Add myIssue
1376        Set myIssue = Nothing
1377    End If
1378
1379    If (bHasTooManyTabs) Then
1380        Set myIssue = New IssueInfo
1381
1382        With myIssue
1383            .IssueID = CID_INDEX_AND_REFERENCES
1384            .IssueType = RID_STR_WORD_ISSUE_INDEX_AND_REFERENCES
1385            .SubType = RID_STR_WORD_SUBISSUE_NUMBERING_TAB_OVERFLOW
1386            .Location = .CLocationDocument 'Location string
1387
1388            .IssueTypeXML = CSTR_ISSUE_INDEX_AND_REFERENCES
1389            .SubTypeXML = CSTR_SUBISSUE_NUMBERING_TAB_OVERFLOW
1390            .locationXML = .CXMLLocationDocument
1391
1392            AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_NUMBERING_TAB_OVERFLOW
1393
1394            docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) = _
1395                    docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) + 1
1396        End With
1397        docAnalysis.Issues.Add myIssue
1398        Set myIssue = Nothing
1399    End If
1400
1401FinalExit:
1402    Exit Sub
1403
1404HandleErrors:
1405    WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
1406    Set myIssue = Nothing
1407    Resume FinalExit
1408End Sub
1409
1410Sub Analyze_Numbering(currDoc As Document, docAnalysis As DocumentAnalysis)
1411    On Error GoTo HandleErrors
1412    Dim currentFunctionName As String
1413    currentFunctionName = "Analyze_Numbering"
1414
1415    Dim myIssue As IssueInfo
1416    Dim nFormatProblems As Integer
1417    Dim nAlignmentProblems As Integer
1418    nFormatProblems = 0
1419    nAlignmentProblems = 0
1420
1421    Dim lt As ListTemplate
1422    Dim lvl As ListLevel
1423    Dim I, l_, p1, p2, v1, v2 As Integer
1424    Dim display_levels As Integer
1425    Dim fmt, prefix, postfix, res As String
1426
1427    For Each lt In currDoc.ListTemplates
1428        l_ = 0
1429        For Each lvl In lt.ListLevels
1430            l_ = l_ + 1
1431            'Selection.TypeText Text:="List Number Format " + lvl.NumberFormat
1432            'Apply Heuristic
1433            fmt = lvl.NumberFormat
1434            p1 = InStr(fmt, "%")
1435            p2 = InStrRev(fmt, "%")
1436            v1 = val(Mid(fmt, p1 + 1, 1))
1437            v2 = val(Mid(fmt, p2 + 1, 1))
1438            display_levels = v2 - v1 + 1
1439            prefix = Mid(fmt, 1, p1 - 1)
1440            postfix = Mid(fmt, p2 + 2)
1441            'Check Heuristic
1442            res = prefix
1443            For I = 2 To display_levels
1444                res = "%" + Trim(Str(l_ - I + 1)) + "." + res
1445            Next
1446            res = res + "%" + Trim(Str(l_)) + postfix
1447            If (StrComp(res, fmt) <> 0) Then
1448                nFormatProblems = nFormatProblems + 1
1449                'Selection.TypeText Text:="Label Problem: NumberFormat=" + fmt + " Heuristic=" + res
1450            End If
1451
1452            'check alignment
1453            If (lvl.NumberPosition <> wdListLevelAlignLeft) Then
1454                nAlignmentProblems = nAlignmentProblems + 1
1455                'Selection.TypeText Text:="Number alignment problem"
1456            End If
1457        Next
1458    Next
1459
1460    If (nFormatProblems > 0) Then
1461        Set myIssue = New IssueInfo
1462
1463        With myIssue
1464            .IssueID = CID_INDEX_AND_REFERENCES
1465            .IssueType = RID_STR_WORD_ISSUE_INDEX_AND_REFERENCES
1466            .SubType = RID_STR_WORD_SUBISSUE_NUMBERING_FORMAT
1467            .Location = .CLocationDocument 'Location string
1468
1469            .IssueTypeXML = CSTR_ISSUE_INDEX_AND_REFERENCES
1470            .SubTypeXML = CSTR_SUBISSUE_NUMBERING_FORMAT
1471            .locationXML = .CXMLLocationDocument
1472
1473            .Attributes.Add RID_STR_WORD_ATTRIBUTE_COUNT
1474            .Values.Add nFormatProblems
1475
1476            AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_NUMBERING_FORMAT
1477
1478            docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) = _
1479                    docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) + 1
1480        End With
1481        docAnalysis.Issues.Add myIssue
1482        Set myIssue = Nothing
1483    End If
1484
1485    If (nAlignmentProblems > 0) Then
1486        Set myIssue = New IssueInfo
1487
1488        With myIssue
1489            .IssueID = CID_INDEX_AND_REFERENCES
1490            .IssueType = RID_STR_WORD_ISSUE_INDEX_AND_REFERENCES
1491            .SubType = RID_STR_WORD_SUBISSUE_NUMBERING_ALIGNMENT
1492            .Location = .CLocationDocument 'Location string
1493
1494            .IssueTypeXML = CSTR_ISSUE_INDEX_AND_REFERENCES
1495            .SubTypeXML = CSTR_SUBISSUE_NUMBERING_ALIGNMENT
1496            .locationXML = .CXMLLocationDocument
1497
1498            .Attributes.Add RID_STR_WORD_ATTRIBUTE_COUNT
1499            .Values.Add nAlignmentProblems
1500
1501            AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_NUMBERING_ALIGNMENT
1502
1503            docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) = _
1504                    docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) + 1
1505        End With
1506        docAnalysis.Issues.Add myIssue
1507        Set myIssue = Nothing
1508    End If
1509
1510FinalExit:
1511    Exit Sub
1512
1513HandleErrors:
1514    WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
1515    Set myIssue = Nothing
1516    Resume FinalExit
1517End Sub
1518
1519