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