migrationanalysis/src/driver_docs/sources/word/MigrationAnalyser.cls

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