| VERSION 1.0 CLASS | |
| BEGIN | |
| MultiUse = -1 'True | |
| END | |
| Attribute VB_Name = "MigrationAnalyser" | |
| Attribute VB_GlobalNameSpace = False | |
| Attribute VB_Creatable = False | |
| Attribute VB_PredeclaredId = False | |
| Attribute VB_Exposed = False | |
| '************************************************************************* | |
| ' | |
| ' Licensed to the Apache Software Foundation (ASF) under one | |
| ' or more contributor license agreements. See the NOTICE file | |
| ' distributed with this work for additional information | |
| ' regarding copyright ownership. The ASF licenses this file | |
| ' to you under the Apache License, Version 2.0 (the | |
| ' "License"); you may not use this file except in compliance | |
| ' with the License. You may obtain a copy of the License at | |
| ' | |
| ' http://www.apache.org/licenses/LICENSE-2.0 | |
| ' | |
| ' Unless required by applicable law or agreed to in writing, | |
| ' software distributed under the License is distributed on an | |
| ' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY | |
| ' KIND, either express or implied. See the License for the | |
| ' specific language governing permissions and limitations | |
| ' under the License. | |
| ' | |
| '************************************************************************* | |
| Option Explicit | |
| 'Class variables | |
| Private Enum HFIssueType | |
| hfInline | |
| hfShape | |
| hfFrame | |
| End Enum | |
| Private Enum HFIssueLocation | |
| hfHeader | |
| hffooter | |
| End Enum | |
| Private Type ShapeInfo | |
| top As Single | |
| Height As Single | |
| End Type | |
| Private Type FrameInfo | |
| Height As Single | |
| VerticalPosition As Single | |
| End Type | |
| Private mAnalysis As DocumentAnalysis | |
| Private mOdd As Boolean | |
| Private mbFormFieldErrorLogged As Boolean | |
| Private mbRefFormFieldErrorLogged As Boolean | |
| '***ADDING-ISSUE: Use Following Skeleton as Guideline for Adding Issue | |
| ' For complete list of all RID_STR_... for Issues (IssueType), SubIssues (SubType) and Attributes refer to: | |
| ' word_res.bas and common_res.bas | |
| ' | |
| ' For complete list of all CID_... for Issue Categories(IssueID) and | |
| ' CSTR_... for XML Issues (IssueTypeXML) and XML SubIssues (SubTypeXML) refer to: | |
| ' ApplicationSpecific.bas and CommonMigrationAnalyser.bas | |
| ' | |
| ' You should not have to add any new Issue Categories or matching IssueTypes, only new SubIssues | |
| Sub Analyze_SKELETON() | |
| On Error GoTo HandleErrors | |
| Dim currentFunctionName As String | |
| currentFunctionName = "Analyze_SKELETON" | |
| Dim myIssue As IssueInfo | |
| Set myIssue = New IssueInfo | |
| With myIssue | |
| .IssueID = CID_VBA_MACROS 'Issue Category | |
| .IssueType = RID_STR_COMMON_ISSUE_VBA_MACROS 'Issue String | |
| .SubType = RID_STR_COMMON_SUBISSUE_PROPERTIES 'SubIssue String | |
| .Location = .CLocationDocument 'Location string | |
| .IssueTypeXML = CSTR_ISSUE_VBA_MACROS 'Non localised XML Issue String | |
| .SubTypeXML = CSTR_SUBISSUE_PROPERTIES 'Non localised XML SubIssue String | |
| .locationXML = .CXMLLocationDocument 'Non localised XML location | |
| .SubLocation = 0 'if not set will default to RID_STR_NOT_AVAILABLE_SHORTHAND | |
| .Line = 0 'if not set will default to RID_STR_NOT_AVAILABLE_SHORTHAND | |
| .column = 0 'if not set will default to RID_STR_NOT_AVAILABLE_SHORTHAND | |
| ' Add as many Attribute Value pairs as needed | |
| ' Note: following must always be true - Attributes.Count = Values.Count | |
| .Attributes.Add "AAA" | |
| .Values.Add "foobar" | |
| ' Use AddIssueDetailsNote to add notes to the Issue Details if required | |
| ' Public Sub AddIssueDetailsNote(myIssue As IssueInfo, noteNum As Long, noteStr As String, _ | |
| ' Optional preStr As String = RID_STR_COMMON_NOTE_PRE) | |
| ' Where preStr is prepended to the output, with "Note" as the default | |
| AddIssueDetailsNote myIssue, 0, RID_STR_COMMON_NOTE_DOCUMENT_PROPERTIES_LOST | |
| 'Only put this in if you have a preparation function added for this issue in CommonPreparation | |
| 'or Preparation - NUll can be replaced with any variant if you want to pass info to the Prepare fnc | |
| Call DoPreparation(mAnalysis, myIssue, "", Null, Null) | |
| mAnalysis.IssuesCountArray(CID_VBA_MACROS) = _ | |
| mAnalysis.IssuesCountArray(CID_VBA_MACROS) + 1 | |
| End With | |
| mAnalysis.Issues.Add myIssue | |
| FinalExit: | |
| Set myIssue = Nothing | |
| Exit Sub | |
| HandleErrors: | |
| WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source | |
| Resume FinalExit | |
| End Sub | |
| Sub DoAnalyse(fileName As String, userFormTypesDict As Scripting.Dictionary, _ | |
| startDir As String, storeToDir As String, fso As FileSystemObject) | |
| On Error GoTo HandleErrors | |
| Dim currentFunctionName As String | |
| currentFunctionName = "DoAnalyse" | |
| mAnalysis.name = fileName | |
| Dim aDoc As Document | |
| Dim bUnprotectError As Boolean | |
| mAnalysis.TotalIssueTypes = CTOTAL_CATEGORIES | |
| mbFormFieldErrorLogged = False | |
| mbRefFormFieldErrorLogged = False | |
| 'Turn off any AutoExce macros before loading the Word doc | |
| On Error Resume Next ' Ignore errors on setting | |
| WordBasic.DisableAutoMacros 1 | |
| On Error GoTo HandleErrors | |
| Dim myPassword As String | |
| myPassword = GetDefaultPassword | |
| 'Always skip password protected documents | |
| 'If IsSkipPasswordDocs() Then | |
| Dim aPass As String | |
| If myPassword <> "" Then | |
| aPass = myPassword | |
| Else | |
| aPass = "xoxoxoxoxo" | |
| End If | |
| On Error Resume Next | |
| Set aDoc = Documents.Open(fileName, False, False, False, _ | |
| aPass, aPass, False, aPass, aPass, wdOpenFormatAuto, _ | |
| msoEncodingAutoDetect, False) | |
| If Err.Number = 5408 Then | |
| ' if password protected, try open readonly next | |
| Set aDoc = Documents.Open(fileName, False, True, False, _ | |
| aPass, aPass, False, aPass, aPass, wdOpenFormatAuto, _ | |
| msoEncodingAutoDetect, False) | |
| End If | |
| If Err.Number = 5408 Then | |
| HandleProtectedDocInvalidPassword mAnalysis, _ | |
| "User entered Invalid Document Password, further analysis not possible", fso | |
| Analyze_Password_Protection True, False | |
| GoTo FinalExit | |
| ElseIf (Err.Number <> 0) Then | |
| GoTo HandleErrors | |
| End If | |
| On Error GoTo HandleErrors | |
| If aDoc Is Nothing Then GoTo FinalExit | |
| 'Do Analysis | |
| Analyze_Password_Protection aDoc.HasPassword, aDoc.WriteReserved | |
| Analyze_Document_Protection aDoc | |
| If aDoc.ProtectionType <> wdNoProtection Then | |
| If myPassword <> "" Then | |
| aDoc.Unprotect (myPassword) | |
| Else | |
| aDoc.Unprotect | |
| End If | |
| End If | |
| 'Set Doc Properties | |
| SetDocProperties mAnalysis, aDoc, fso | |
| ContinueFromUnprotectError: | |
| Analyze_Tables_TablesInTables aDoc | |
| Analyze_Tables_Borders aDoc | |
| Analyze_TOA aDoc | |
| If Not bUnprotectError Then | |
| Analyze_FieldAndFormFieldIssues aDoc | |
| End If | |
| Analyze_OLEEmbedded aDoc | |
| Analyze_MailMerge_DataSource aDoc | |
| Analyze_Macros mAnalysis, userFormTypesDict, aDoc | |
| 'Analyze_Numbering aDoc, mAnalysis | |
| 'Analyze_NumberingTabs aDoc, mAnalysis | |
| ' Doc Preparation only | |
| ' Save document with any prepared issues under <storeToDir>\prepared\<source doc name> | |
| If mAnalysis.PreparableIssuesCount > 0 And CheckDoPrepare Then | |
| Dim preparedFullPath As String | |
| preparedFullPath = GetPreparedFullPath(mAnalysis.name, startDir, storeToDir, fso) | |
| If preparedFullPath <> "" Then | |
| If fso.FileExists(preparedFullPath) Then | |
| fso.DeleteFile preparedFullPath, True | |
| End If | |
| If fso.FolderExists(fso.GetParentFolderName(preparedFullPath)) Then | |
| aDoc.SaveAs preparedFullPath | |
| End If | |
| End If | |
| End If | |
| 'DebugMacroInfo | |
| FinalExit: | |
| If Not aDoc Is Nothing Then 'If Not IsEmpty(aDoc) Then | |
| aDoc.Close (False) | |
| End If | |
| Set aDoc = Nothing | |
| Exit Sub | |
| HandleErrors: | |
| ' MsgBox currentFunctionName & " : " & fileName & ": " & Err.Number & " " & Err.Description & " " & Err.Source | |
| ' Handle Password error on Doc Open, Modify and Cancel | |
| If Err.Number = 5408 Or Err.Number = 4198 Then | |
| WriteDebug currentFunctionName & " : " & fileName & ": " & _ | |
| "User entered Invalid Document Password - " & Err.Number & " " & Err.Description & " " & Err.Source | |
| HandleProtectedDocInvalidPassword mAnalysis, _ | |
| "User entered Invalid Document Password, further analysis not possible", fso | |
| Resume FinalExit | |
| ElseIf Err.Number = 5485 Then | |
| ' Handle Password error on Unprotect Doc | |
| WriteDebug currentFunctionName & " : " & fileName & ": " & _ | |
| "User entered Invalid Document Part Password, Analysis of doc will continue but will skip analysis of:" & _ | |
| "Forms, Comments, Headers & Footers and Table cell spanning issues - " & Err.Number & " " & Err.Description & " " & Err.Source | |
| HandleProtectedDocInvalidPassword mAnalysis, _ | |
| "User entered Invalid Document Part Password, Analysis of doc will continue but will skip analysis of:" & vbLf & _ | |
| "Forms, Comments, Headers & Footers and Table cell spanning issues", fso | |
| bUnprotectError = True | |
| 'wdAllowOnlyComments, wdAllowOnlyFormFields, wdAllowOnlyRevisions | |
| Resume ContinueFromUnprotectError | |
| End If | |
| mAnalysis.Application = RID_STR_COMMON_CANNOT_OPEN | |
| WriteDebug currentFunctionName & " : " & fileName & ": " & Err.Number & " " & Err.Description & " " & Err.Source | |
| Resume FinalExit | |
| End Sub | |
| Sub DebugMacroInfo() | |
| MsgBox "TotalNumLines: " & mAnalysis.MacroTotalNumLines & vbLf & _ | |
| "NumUserForms: " & mAnalysis.MacroNumUserForms & vbLf & _ | |
| "NumUserFormControls: " & mAnalysis.MacroNumUserFormControls & vbLf & _ | |
| "NumUserFormControlTypes: " & mAnalysis.MacroNumUserFormControlTypes & vbLf & _ | |
| "NumExternalRefs: " & mAnalysis.MacroNumExternalRefs & vbLf & _ | |
| "MacroNumFieldsUsingMacros: " & mAnalysis.MacroNumFieldsUsingMacros & vbLf & _ | |
| "NumOLEControls: " & mAnalysis.MacroNumOLEControls & vbLf & _ | |
| "MacroOverallClass: " & getDocOverallMacroClassAsString(mAnalysis.MacroOverallClass) | |
| End Sub | |
| Sub SetDocProperties(docAnalysis As DocumentAnalysis, doc As Document, fso As FileSystemObject) | |
| On Error GoTo HandleErrors | |
| Dim currentFunctionName As String | |
| currentFunctionName = "SetProperties" | |
| Dim f As File | |
| Set f = fso.GetFile(docAnalysis.name) | |
| docAnalysis.PageCount = doc.ComputeStatistics(wdStatisticPages) | |
| docAnalysis.Accessed = f.DateLastAccessed | |
| On Error Resume Next 'Some apps may not support all props | |
| docAnalysis.Application = getAppSpecificApplicationName & " " & Application.Version | |
| 'docAnalysis.Application = doc.BuiltinDocumentProperties(wdPropertyAppName) | |
| 'If InStr(docAnalysis.Application, "Microsoft") = 1 Then | |
| ' docAnalysis.Application = Mid(docAnalysis.Application, Len("Microsoft") + 2) | |
| 'End If | |
| 'If InStr(Len(docAnalysis.Application) - 2, docAnalysis.Application, ".") = 0 Then | |
| ' docAnalysis.Application = docAnalysis.Application & " " & Application.Version | |
| 'End If | |
| docAnalysis.Created = _ | |
| doc.BuiltInDocumentProperties(wdPropertyTimeCreated) | |
| docAnalysis.Modified = _ | |
| doc.BuiltInDocumentProperties(wdPropertyTimeLastSaved) | |
| docAnalysis.Printed = _ | |
| doc.BuiltInDocumentProperties(wdPropertyTimeLastPrinted) | |
| docAnalysis.SavedBy = _ | |
| doc.BuiltInDocumentProperties(wdPropertyLastAuthor) | |
| docAnalysis.Revision = _ | |
| val(doc.BuiltInDocumentProperties(wdPropertyRevision)) | |
| docAnalysis.Template = _ | |
| fso.GetFileName(doc.BuiltInDocumentProperties(wdPropertyTemplate)) | |
| FinalExit: | |
| Set f = Nothing | |
| Exit Sub | |
| HandleErrors: | |
| WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source | |
| Resume FinalExit | |
| End Sub | |
| 'Limitation: Detect first level table in tables, does not detect further nesting | |
| 'Can do so if required | |
| Sub Analyze_Tables_TablesInTables(currDoc As Document) | |
| On Error GoTo HandleErrors | |
| Dim currentFunctionName As String | |
| currentFunctionName = "Analyze_Tables_TablesInTables" | |
| Dim myTopTable As Table | |
| Dim myInnerTable As Table | |
| Dim myIssue As IssueInfo | |
| For Each myTopTable In currDoc.Tables | |
| For Each myInnerTable In myTopTable.Tables | |
| Dim logString As String | |
| Dim myRng As Range | |
| Dim startpage As Long | |
| Dim startRow As Long | |
| Dim StartColumn As Long | |
| Dim details As String | |
| Set myIssue = New IssueInfo | |
| Set myRng = myInnerTable.Range | |
| myRng.start = myRng.End | |
| startpage = myRng.Information(wdActiveEndPageNumber) | |
| startRow = myRng.Information(wdStartOfRangeRowNumber) | |
| StartColumn = myRng.Information(wdStartOfRangeColumnNumber) | |
| With myIssue | |
| .IssueID = CID_TABLES | |
| .IssueType = RID_STR_WORD_ISSUE_TABLES | |
| .SubType = RID_STR_WORD_SUBISSUE_NESTED_TABLES | |
| .Location = .CLocationPage | |
| .SubLocation = startpage | |
| .IssueTypeXML = CSTR_ISSUE_TABLES | |
| .SubTypeXML = CSTR_SUBISSUE_NESTED_TABLES | |
| .locationXML = .CXMLLocationPage | |
| .Attributes.Add RID_STR_WORD_ATTRIBUTE_OUTER_TABLE | |
| .Values.Add myTopTable.Rows.count & "x" & myTopTable.Columns.count | |
| .Attributes.Add RID_STR_WORD_ATTRIBUTE_INNER_TABLE | |
| .Values.Add myInnerTable.Rows.count & "x" & myInnerTable.Columns.count | |
| .Attributes.Add RID_STR_WORD_ATTRIBUTE_START_ROW | |
| .Values.Add startRow | |
| .Attributes.Add RID_STR_WORD_ATTRIBUTE_START_COL | |
| .Values.Add StartColumn | |
| AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_NESTED_TABLE_WILL_BE_LOST | |
| mAnalysis.IssuesCountArray(CID_TABLES) = _ | |
| mAnalysis.IssuesCountArray(CID_TABLES) + 1 | |
| End With | |
| mAnalysis.Issues.Add myIssue | |
| Set myIssue = Nothing | |
| Set myRng = Nothing | |
| Next | |
| Next | |
| Exit Sub | |
| HandleErrors: | |
| WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source | |
| End Sub | |
| Sub Analyze_Document_Protection(currDoc As Document) | |
| On Error GoTo HandleErrors | |
| Dim currentFunctionName As String | |
| currentFunctionName = "Analyze_Document_Protection" | |
| If currDoc.ProtectionType = wdNoProtection Then | |
| Exit Sub | |
| End If | |
| Dim myIssue As IssueInfo | |
| Set myIssue = New IssueInfo | |
| With myIssue | |
| .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES | |
| .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES | |
| .SubType = RID_STR_COMMON_SUBISSUE_DOCUMENT_PARTS_PROTECTION | |
| .Location = .CLocationDocument | |
| .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES | |
| .SubTypeXML = CSTR_SUBISSUE_DOCUMENT_PARTS_PROTECTION | |
| .locationXML = .CXMLLocationDocument | |
| .Attributes.Add RID_STR_WORD_ATTRIBUTE_PROTECTION | |
| Select Case currDoc.ProtectionType | |
| Case wdAllowOnlyComments | |
| .Values.Add RID_STR_WORD_ATTRIBUTE_ALLOW_ONLY_COMMENTS | |
| Case wdAllowOnlyFormFields | |
| .Values.Add RID_STR_WORD_ATTRIBUTE_ALLOW_ONLY_FORM_FIELDS | |
| Case wdAllowOnlyRevisions | |
| .Values.Add RID_STR_WORD_ATTRIBUTE_ALLOW_ONLY_REVISIONS | |
| Case Else | |
| .Values.Add RID_STR_COMMON_ATTRIBUTE_UNKNOWN | |
| End Select | |
| mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ | |
| mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 | |
| End With | |
| mAnalysis.Issues.Add myIssue | |
| FinalExit: | |
| Set myIssue = Nothing | |
| Exit Sub | |
| HandleErrors: | |
| WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source | |
| Resume FinalExit | |
| End Sub | |
| Sub Analyze_Password_Protection(bHasPassword As Boolean, bWriteReserved As Boolean) | |
| On Error GoTo HandleErrors | |
| Dim currentFunctionName As String | |
| currentFunctionName = "Analyze_Password_Protection" | |
| Dim myIssue As IssueInfo | |
| If bHasPassword Or bWriteReserved Then | |
| Set myIssue = New IssueInfo | |
| With myIssue | |
| .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES | |
| .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES | |
| .SubType = RID_STR_COMMON_SUBISSUE_PASSWORDS_PROTECTION | |
| .Location = .CLocationDocument | |
| .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES | |
| .SubTypeXML = CSTR_SUBISSUE_PASSWORDS_PROTECTION | |
| .locationXML = .CXMLLocationDocument | |
| If bHasPassword Then | |
| .Attributes.Add RID_STR_WORD_ATTRIBUTE_PASSWORD_TO_OPEN | |
| .Values.Add RID_STR_WORD_ATTRIBUTE_SET | |
| End If | |
| If bWriteReserved Then | |
| .Attributes.Add RID_STR_WORD_ATTRIBUTE_PASSWORD_TO_MODIFY | |
| .Values.Add RID_STR_WORD_ATTRIBUTE_SET | |
| End If | |
| mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ | |
| mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 | |
| End With | |
| mAnalysis.Issues.Add myIssue | |
| End If | |
| FinalExit: | |
| Set myIssue = Nothing | |
| Exit Sub | |
| HandleErrors: | |
| WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source | |
| Resume FinalExit | |
| End Sub | |
| Sub Analyze_OLEEmbedded(currDoc As Document) | |
| On Error GoTo HandleErrors | |
| Dim currentFunctionName As String | |
| currentFunctionName = "Analyze_OLEEmbedded" | |
| ' Handle Inline Shapes | |
| Dim aILShape As InlineShape | |
| For Each aILShape In currDoc.InlineShapes | |
| Analyze_OLEEmbeddedSingleInlineShape aILShape | |
| Next aILShape | |
| ' Handle Shapes | |
| Dim aShape As Shape | |
| For Each aShape In currDoc.Shapes | |
| Analyze_OLEEmbeddedSingleShape mAnalysis, aShape, _ | |
| Selection.Information(wdActiveEndPageNumber) | |
| Analyze_Lines mAnalysis, aShape, _ | |
| Selection.Information(wdActiveEndPageNumber) | |
| Analyze_Transparency mAnalysis, aShape, _ | |
| Selection.Information(wdActiveEndPageNumber) | |
| Analyze_Gradients mAnalysis, aShape, _ | |
| Selection.Information(wdActiveEndPageNumber) | |
| Next aShape | |
| Exit Sub | |
| HandleErrors: | |
| WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source | |
| End Sub | |
| 'WdInlineShapeType constants: | |
| 'wdInlineShapeEmbeddedOLEObject, wdInlineShapeHorizontalLine, wdInlineShapeLinkedOLEObject, | |
| 'wdInlineShapeLinkedPicture, wdInlineShapeLinkedPictureHorizontalLine, wdInlineShapeOLEControlObject, | |
| 'wdInlineShapeOWSAnchor, wdInlineShapePicture, wdInlineShapePictureBullet, | |
| 'wdInlineShapePictureHorizontalLine, wdInlineShapeScriptAnchor | |
| Sub Analyze_OLEEmbeddedSingleInlineShape(aILShape As InlineShape) | |
| On Error GoTo HandleErrors | |
| Dim currentFunctionName As String | |
| currentFunctionName = "Analyze_OLEEmbeddedSingleInlineShape" | |
| Dim myIssue As IssueInfo | |
| Dim bOleObject As Boolean | |
| Dim TypeAsString As String | |
| Dim XMLTypeAsString As String | |
| Dim objName As String | |
| bOleObject = (aILShape.Type = wdInlineShapeEmbeddedOLEObject) Or _ | |
| (aILShape.Type = wdInlineShapeLinkedOLEObject) Or _ | |
| (aILShape.Type = wdInlineShapeOLEControlObject) | |
| If Not bOleObject Then Exit Sub | |
| aILShape.Select | |
| Select Case aILShape.Type | |
| Case wdInlineShapeOLEControlObject | |
| TypeAsString = RID_STR_COMMON_OLE_CONTROL | |
| XMLTypeAsString = CSTR_SUBISSUE_OLE_CONTROL | |
| Case wdInlineShapeEmbeddedOLEObject | |
| TypeAsString = RID_STR_COMMON_OLE_EMBEDDED | |
| XMLTypeAsString = CSTR_SUBISSUE_OLE_EMBEDDED | |
| Case wdInlineShapeLinkedOLEObject | |
| TypeAsString = RID_STR_COMMON_OLE_LINKED | |
| XMLTypeAsString = CSTR_SUBISSUE_OLE_LINKED | |
| Case Else | |
| TypeAsString = RID_STR_COMMON_OLE_UNKNOWN | |
| XMLTypeAsString = CSTR_SUBISSUE_OLE_UNKNOWN | |
| End Select | |
| Set myIssue = New IssueInfo | |
| With myIssue | |
| .IssueID = CID_PORTABILITY | |
| .IssueType = RID_STR_COMMON_ISSUE_PORTABILITY | |
| .SubType = TypeAsString | |
| .Location = .CLocationPage | |
| .SubLocation = Selection.Information(wdActiveEndPageNumber) | |
| .IssueTypeXML = CSTR_ISSUE_PORTABILITY | |
| .SubTypeXML = XMLTypeAsString | |
| .locationXML = .CXMLLocationPage | |
| .Line = Selection.Information(wdFirstCharacterLineNumber) | |
| .column = Selection.Information(wdFirstCharacterColumnNumber) | |
| DoEvents | |
| If aILShape.Type = wdInlineShapeEmbeddedOLEObject Or _ | |
| aILShape.Type = wdInlineShapeOLEControlObject Then | |
| 'If Object is invalid can get automation server hanging | |
| Dim tmpStr As String | |
| On Error Resume Next | |
| tmpStr = aILShape.OLEFormat.Object | |
| If Err.Number = 0 Then | |
| .Attributes.Add RID_STR_COMMON_ATTRIBUTE_OBJECT_TYPE | |
| .Values.Add aILShape.OLEFormat.ProgID | |
| Else | |
| Err.Clear | |
| tmpStr = aILShape.OLEFormat.ClassType | |
| If Err.Number = 0 Then | |
| .Attributes.Add RID_STR_COMMON_ATTRIBUTE_OBJECT_TYPE | |
| .Values.Add aILShape.OLEFormat.ClassType | |
| Else | |
| .Attributes.Add RID_STR_COMMON_ATTRIBUTE_OBJECT_TYPE | |
| .Values.Add RID_STR_COMMON_NA | |
| End If | |
| End If | |
| If aILShape.Type = wdInlineShapeOLEControlObject Then | |
| mAnalysis.MacroNumOLEControls = 1 + mAnalysis.MacroNumOLEControls | |
| End If | |
| objName = aILShape.OLEFormat.Object.name | |
| If Err.Number = 0 Then | |
| .Attributes.Add RID_STR_COMMON_ATTRIBUTE_OBJECT_NAME | |
| .Values.Add objName | |
| End If | |
| On Error GoTo HandleErrors | |
| End If | |
| If aILShape.Type = wdInlineShapeLinkedOLEObject Then | |
| .Attributes.Add RID_STR_COMMON_ATTRIBUTE_SOURCE | |
| .Values.Add aILShape.LinkFormat.SourceFullName | |
| End If | |
| mAnalysis.IssuesCountArray(CID_PORTABILITY) = _ | |
| mAnalysis.IssuesCountArray(CID_PORTABILITY) + 1 | |
| End With | |
| mAnalysis.Issues.Add myIssue | |
| FinalExit: | |
| Set myIssue = Nothing | |
| Exit Sub | |
| HandleErrors: | |
| WriteDebugLevelTwo currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source | |
| Resume FinalExit | |
| End Sub | |
| 'Appears to be picked up by other OLE analysis code - the Shapes are actually field codes | |
| 'So I get double reporting if I use this as well. | |
| Sub Analyze_OLEFields(myField As Field) | |
| On Error GoTo HandleErrors | |
| Dim currentFunctionName As String | |
| currentFunctionName = "Analyze_OLEFields" | |
| Dim myIssue As IssueInfo | |
| Dim bOleObject As Boolean | |
| Dim TypeAsString As String | |
| Dim XMLTypeAsString As String | |
| bOleObject = (myField.Type = wdFieldOCX) | |
| If Not bOleObject Then Exit Sub | |
| myField.Select | |
| Select Case myField.Type | |
| Case wdFieldLink | |
| TypeAsString = RID_STR_COMMON_OLE_FIELD_LINK | |
| XMLTypeAsString = CSTR_SUBISSUE_OLE_FIELD_LINK | |
| Case Else | |
| TypeAsString = RID_STR_COMMON_OLE_UNKNOWN | |
| XMLTypeAsString = CSTR_SUBISSUE_OLE_UNKNOWN | |
| End Select | |
| Set myIssue = New IssueInfo | |
| With myIssue | |
| .IssueID = CID_PORTABILITY | |
| .IssueType = RID_STR_COMMON_ISSUE_PORTABILITY | |
| .SubType = TypeAsString | |
| .Location = .CLocationPage | |
| .SubLocation = Selection.Information(wdActiveEndPageNumber) | |
| .IssueTypeXML = CSTR_ISSUE_PORTABILITY | |
| .SubTypeXML = XMLTypeAsString | |
| .locationXML = .CXMLLocationPage | |
| .Line = Selection.Information(wdFirstCharacterLineNumber) | |
| .column = Selection.Information(wdFirstCharacterColumnNumber) | |
| .Attributes.Add RID_STR_COMMON_ATTRIBUTE_OBJECT_TYPE | |
| .Values.Add myField.OLEFormat.ClassType | |
| If myField.Type = wdFieldLink Then | |
| .Attributes.Add RID_STR_WORD_ATTRIBUTE_LINK | |
| .Values.Add myField.LinkFormat.SourceFullName | |
| End If | |
| mAnalysis.IssuesCountArray(CID_PORTABILITY) = _ | |
| mAnalysis.IssuesCountArray(CID_PORTABILITY) + 1 | |
| End With | |
| mAnalysis.Issues.Add myIssue | |
| Set myIssue = Nothing | |
| Exit Sub | |
| HandleErrors: | |
| Set myIssue = Nothing | |
| WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source | |
| End Sub | |
| Sub Analyze_MailMergeField(myField As Field) | |
| On Error GoTo HandleErrors | |
| Dim currentFunctionName As String | |
| currentFunctionName = "Analyze_MailMergeField" | |
| Dim myIssue As IssueInfo | |
| Dim TypeAsString As String | |
| Dim bProblemMailMergeField As Boolean | |
| bProblemMailMergeField = _ | |
| (myField.Type = wdFieldFillIn) Or _ | |
| (myField.Type = wdFieldAsk) Or _ | |
| (myField.Type = wdFieldMergeRec) Or _ | |
| (myField.Type = wdFieldMergeField) Or _ | |
| (myField.Type = wdFieldNext) Or _ | |
| (myField.Type = wdFieldRevisionNum) Or _ | |
| (myField.Type = wdFieldSequence) Or _ | |
| (myField.Type = wdFieldAutoNum) Or _ | |
| (myField.Type = wdFieldAutoNumOutline) Or _ | |
| (myField.Type = wdFieldAutoNumLegal) | |
| If bProblemMailMergeField Then | |
| 'Some of the following are numbering fields and need to be broken out into a seperate function. See migration guide. | |
| Select Case myField.Type | |
| Case wdFieldFillIn | |
| TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_FILL_IN | |
| Case wdFieldAsk | |
| TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_ASK | |
| Case wdFieldMergeRec | |
| TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_MERGE_RECORDS | |
| Case wdFieldMergeField | |
| TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_MERGE_FIELDS | |
| Case wdFieldNext | |
| TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_NEXT | |
| Case wdFieldRevisionNum | |
| TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_REVISION_NUMBER | |
| Case wdFieldSequence | |
| TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_SEQUENCE | |
| Case wdFieldAutoNum | |
| TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_AUTO_NUMBER | |
| Case wdFieldAutoNumOutline | |
| TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_AUTO_NUMBER_OUTLINE | |
| Case wdFieldAutoNumLegal | |
| TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_AUTO_NUMBER_LEGAL | |
| Case Else | |
| TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_FIELD_NAME_NOT_KNOWN | |
| End Select | |
| Set myIssue = New IssueInfo | |
| myField.Select | |
| With myIssue | |
| .IssueID = CID_FIELDS | |
| .IssueType = RID_STR_WORD_ISSUE_FIELDS | |
| .SubType = RID_STR_WORD_SUBISSUE_MAILMERGE_FIELD | |
| .Location = .CLocationPage | |
| .IssueTypeXML = CSTR_ISSUE_FIELDS | |
| .SubTypeXML = CSTR_SUBISSUE_MAILMERGE_FIELD | |
| .locationXML = .CXMLLocationPage | |
| .SubLocation = Selection.Information(wdActiveEndPageNumber) | |
| .Line = Selection.Information(wdFirstCharacterLineNumber) | |
| .column = Selection.Information(wdFirstCharacterColumnNumber) | |
| .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME | |
| .Values.Add TypeAsString | |
| If myField.Code.Text <> "" Then | |
| .Attributes.Add RID_STR_WORD_ATTRIBUTE_TEXT | |
| .Values.Add myField.Code.Text | |
| End If | |
| mAnalysis.IssuesCountArray(CID_FIELDS) = _ | |
| mAnalysis.IssuesCountArray(CID_FIELDS) + 1 | |
| End With | |
| mAnalysis.Issues.Add myIssue | |
| Set myIssue = Nothing | |
| End If | |
| Exit Sub | |
| HandleErrors: | |
| WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source | |
| End Sub | |
| 'Get field DS Info | |
| Sub Analyze_MailMerge_DataSource(currDoc As Document) | |
| On Error GoTo HandleErrors | |
| Dim currentFunctionName As String | |
| currentFunctionName = "Analyze_MailMerge_DataSource" | |
| ' There may be no mail merge in the document | |
| If (currDoc.MailMerge.DataSource.Type = wdNoMergeInfo) Then | |
| Exit Sub | |
| End If | |
| 'Dim issue As SimpleAnalysisInfo | |
| If (currDoc.MailMerge.DataSource.Type <> wdNoMergeInfo) Then | |
| Dim myIssue As IssueInfo | |
| Set myIssue = New IssueInfo | |
| With myIssue | |
| .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES | |
| .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES | |
| .SubType = RID_STR_WORD_SUBISSUE_MAILMERGE_DATASOURCE | |
| .Location = .CLocationDocument | |
| .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES | |
| .SubTypeXML = CSTR_SUBISSUE_MAILMERGE_DATASOURCE | |
| .locationXML = .CXMLLocationDocument | |
| .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME | |
| .Values.Add currDoc.MailMerge.DataSource.name | |
| .Attributes.Add RID_STR_WORD_ATTRIBUTE_DATASOURCE | |
| .Values.Add currDoc.MailMerge.DataSource.Type | |
| mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ | |
| mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 | |
| End With | |
| mAnalysis.Issues.Add myIssue | |
| Set myIssue = Nothing | |
| End If | |
| Exit Sub | |
| HandleErrors: | |
| WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source | |
| End Sub | |
| Function getFormFieldTypeAsString(fieldType As WdFieldType) | |
| Dim Str As String | |
| Select Case fieldType | |
| Case wdFieldFormCheckBox | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_CHECK_BOX | |
| Case wdFieldFormDropDown | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DROP_DOWN | |
| Case wdFieldFormTextInput | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_TEXT | |
| Case Else | |
| Str = RID_STR_WORD_ENUMERATION_UNKNOWN | |
| End Select | |
| getFormFieldTypeAsString = Str | |
| End Function | |
| Function getTextFormFieldTypeAsString(fieldType As WdTextFormFieldType) | |
| Dim Str As String | |
| Select Case fieldType | |
| Case wdCalculationText | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_CALCULATION | |
| Case wdCurrentDateText | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_CURRENT_DATE | |
| Case wdCurrentTimeText | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_CURRENT_TIME | |
| Case wdDateText | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DATE | |
| Case wdNumberText | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_NUMBER | |
| Case wdRegularText | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_REGULAR | |
| Case Else | |
| Str = RID_STR_WORD_ENUMERATION_UNKNOWN | |
| End Select | |
| getTextFormFieldTypeAsString = Str | |
| End Function | |
| Function getTextFormFieldDefaultAsString(fieldType As WdTextFormFieldType) | |
| Dim Str As String | |
| Select Case fieldType | |
| Case wdCalculationText | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DEFAULT_EXPRESSION | |
| Case wdCurrentDateText | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DEFAULT_DATE | |
| Case wdCurrentTimeText | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DEFAULT_TIME | |
| Case wdDateText | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DEFAULT_DATE | |
| Case wdNumberText | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DEFAULT_NUMBER | |
| Case wdRegularText | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DEFAULT_TEXT | |
| Case Else | |
| Str = RID_STR_WORD_ENUMERATION_UNKNOWN | |
| End Select | |
| getTextFormFieldDefaultAsString = Str | |
| End Function | |
| Function getTextFormFieldFormatAsString(fieldType As WdTextFormFieldType) | |
| Dim Str As String | |
| Select Case fieldType | |
| Case wdCalculationText | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_FORMAT_NUMBER | |
| Case wdCurrentDateText | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_FORMAT_DATE | |
| Case wdCurrentTimeText | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_FORMAT_TIME | |
| Case wdDateText | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_FORMAT_DATE | |
| Case wdNumberText | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_FORMAT_NUMBER | |
| Case wdRegularText | |
| Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_FORMAT_TEXT | |
| Case Else | |
| Str = RID_STR_WORD_ENUMERATION_UNKNOWN | |
| End Select | |
| getTextFormFieldFormatAsString = Str | |
| End Function | |
| Sub Analyze_FieldAndFormFieldIssues(currDoc As Document) | |
| On Error GoTo HandleErrors | |
| Dim currentFunctionName As String | |
| currentFunctionName = "Analyze_FormFields" | |
| Dim myIssue As IssueInfo | |
| 'Analysze all Fields in doc | |
| Dim myField As Field | |
| For Each myField In currDoc.Fields | |
| 'Analyze Mail Merge Fields | |
| Analyze_MailMergeField myField | |
| 'Analyze TOA Fields | |
| Analyze_TOAField myField | |
| Next myField | |
| 'Analyze FormField doc issues | |
| If currDoc.FormFields.count = 0 Then GoTo FinalExit | |
| If (currDoc.FormFields.Shaded) Then | |
| Set myIssue = New IssueInfo | |
| With myIssue | |
| .IssueID = CID_FIELDS | |
| .IssueType = RID_STR_WORD_ISSUE_FIELDS | |
| .SubType = RID_STR_WORD_SUBISSUE_APPEARANCE | |
| .Location = .CLocationDocument | |
| .IssueTypeXML = CSTR_ISSUE_FIELDS | |
| .SubTypeXML = CSTR_SUBISSUE_APPEARANCE | |
| .locationXML = .CXMLLocationDocument | |
| .Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_GREYED | |
| .Values.Add RID_STR_WORD_TRUE | |
| mAnalysis.IssuesCountArray(CID_FIELDS) = _ | |
| mAnalysis.IssuesCountArray(CID_FIELDS) + 1 | |
| End With | |
| mAnalysis.Issues.Add myIssue | |
| Set myIssue = Nothing | |
| End If | |
| 'Analyse all FormFields in doc | |
| Dim myFormField As FormField | |
| For Each myFormField In currDoc.FormFields | |
| Analyze_FormFieldIssue myFormField | |
| Next myFormField | |
| FinalExit: | |
| Set myIssue = Nothing | |
| Set myFormField = Nothing | |
| Exit Sub | |
| HandleErrors: | |
| WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source | |
| Resume FinalExit | |
| End Sub | |
| Sub Analyze_FormFieldIssue(myFormField As FormField) | |
| On Error GoTo HandleErrors | |
| Dim currentFunctionName As String | |
| currentFunctionName = "Analyze_FormFieldIssue" | |
| Dim myIssue As IssueInfo | |
| Dim bCheckBoxIssues As Boolean | |
| Dim bFormFieldIssues As Boolean | |
| bCheckBoxIssues = False | |
| If (myFormField.Type = wdFieldFormCheckBox) Then | |
| If myFormField.CheckBox.AutoSize Then | |
| bCheckBoxIssues = True | |
| End If | |
| End If | |
| bFormFieldIssues = bCheckBoxIssues | |
| If Not bFormFieldIssues Then GoTo FinalExit | |
| myFormField.Select | |
| Set myIssue = New IssueInfo | |
| With myIssue | |
| .IssueID = CID_FIELDS | |
| .IssueType = RID_STR_WORD_ISSUE_FIELDS | |
| .SubType = RID_STR_WORD_SUBISSUE_FORM_FIELD | |
| .Location = .CLocationPage | |
| .IssueTypeXML = CSTR_ISSUE_FIELDS | |
| .SubTypeXML = CSTR_SUBISSUE_FORM_FIELD | |
| .locationXML = .CXMLLocationPage | |
| .SubLocation = Selection.Information(wdActiveEndPageNumber) | |
| .Line = Selection.Information(wdFirstCharacterLineNumber) | |
| .column = Selection.Information(wdFirstCharacterColumnNumber) | |
| myIssue.Attributes.Add RID_STR_COMMON_ATTRIBUTE_TYPE | |
| myIssue.Values.Add getFormFieldTypeAsString(myFormField.Type) | |
| End With | |
| 'Checkbox Issues | |
| If (myFormField.Type = wdFieldFormCheckBox) Then | |
| 'AutoSize CheckBoxes | |
| If myFormField.CheckBox.AutoSize Then | |
| myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_AUTOSIZE | |
| myIssue.Values.Add RID_STR_WORD_TRUE | |
| End If | |
| End If | |
| 'TextInput Issues | |
| If myFormField.Type = wdFieldFormTextInput Then | |
| myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_TEXT_FORM_FIELD_TYPE | |
| myIssue.Values.Add getTextFormFieldTypeAsString(myFormField.TextInput.Type) | |
| Dim bLostType As Boolean | |
| bLostType = False | |
| If (myFormField.TextInput.Type = wdCalculationText) Or _ | |
| (myFormField.TextInput.Type = wdCurrentDateText) Or _ | |
| (myFormField.TextInput.Type = wdCurrentTimeText) Then | |
| AddIssueDetailsNote myIssue, 0, getTextFormFieldTypeAsString(myFormField.TextInput.Type) & _ | |
| " " & RID_STR_WORD_NOTE_FORM_FIELD_TYPE_LOST | |
| bLostType = True | |
| End If | |
| If (myFormField.TextInput.Format <> "") Then | |
| myIssue.Attributes.Add getTextFormFieldFormatAsString(myFormField.TextInput.Type) | |
| myIssue.Values.Add myFormField.TextInput.Format | |
| End If | |
| 'Default text | |
| If (myFormField.TextInput.Default <> "") Then | |
| myIssue.Attributes.Add getTextFormFieldDefaultAsString(myFormField.TextInput.Type) | |
| myIssue.Values.Add myFormField.TextInput.Default | |
| End If | |
| 'Maximum text | |
| If (myFormField.TextInput.Width <> 0) Then | |
| myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_MAX_LENGTH | |
| myIssue.Values.Add myFormField.TextInput.Width | |
| End If | |
| 'Fill-in disabled | |
| If (myFormField.Enabled = False) And (Not bLostType) Then | |
| myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_FILLIN_ENABLED | |
| myIssue.Values.Add RID_STR_WORD_FALSE | |
| End If | |
| End If | |
| 'Help Key(F1) | |
| If (myFormField.OwnHelp And myFormField.HelpText <> "") Then | |
| myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_HELP_KEY_F1_OWN_TEXT | |
| myIssue.Values.Add myFormField.HelpText | |
| ElseIf ((Not myFormField.OwnHelp) And myFormField.HelpText <> "") Then | |
| myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_HELP_KEY_F1_AUTO_TEXT | |
| myIssue.Values.Add myFormField.HelpText | |
| End If | |
| 'StatusHelp | |
| If (myFormField.OwnStatus And myFormField.StatusText <> "") Then | |
| myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_STATUS_BAR_HELP_OWN_TEXT | |
| myIssue.Values.Add myFormField.StatusText | |
| ElseIf ((Not myFormField.OwnStatus) And myFormField.StatusText <> "") Then | |
| myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_STATUS_BAR_HELP_AUTO_TEXT | |
| myIssue.Values.Add myFormField.StatusText | |
| End If | |
| 'Macros | |
| If (myFormField.EntryMacro <> "") Then | |
| myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_ENTRY_MACRO | |
| myIssue.Values.Add myFormField.EntryMacro | |
| End If | |
| If (myFormField.ExitMacro <> "") Then | |
| myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_EXIT_MACRO | |
| myIssue.Values.Add myFormField.ExitMacro | |
| End If | |
| If (myFormField.EntryMacro <> "") Or (myFormField.ExitMacro <> "") Then | |
| mAnalysis.MacroNumFieldsUsingMacros = 1 + mAnalysis.MacroNumFieldsUsingMacros | |
| End If | |
| 'LockedField | |
| If (myFormField.Enabled = False) And (myFormField.Type <> wdFieldFormTextInput) Then | |
| myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_LOCKED | |
| myIssue.Values.Add RID_STR_WORD_TRUE | |
| End If | |
| mAnalysis.IssuesCountArray(CID_FIELDS) = _ | |
| mAnalysis.IssuesCountArray(CID_FIELDS) + 1 | |
| mAnalysis.Issues.Add myIssue | |
| FinalExit: | |
| Set myIssue = Nothing | |
| Exit Sub | |
| HandleErrors: | |
| 'Log first occurence for this doc | |
| If Not mbFormFieldErrorLogged Then | |
| WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source | |
| mbFormFieldErrorLogged = True | |
| End If | |
| Resume FinalExit | |
| End Sub | |
| Sub Analyze_TOA(currDoc As Document) | |
| On Error GoTo HandleErrors | |
| Dim currentFunctionName As String | |
| currentFunctionName = "Analyze_TOA" | |
| Dim toa As TableOfAuthorities | |
| Dim myIssue As IssueInfo | |
| Dim myRng As Range | |
| For Each toa In currDoc.TablesOfAuthorities | |
| Set myRng = toa.Range | |
| myRng.start = myRng.End | |
| Set myIssue = New IssueInfo | |
| myRng.Select | |
| Dim TabLeaderAsString As String | |
| Select Case toa.TabLeader | |
| Case wdTabLeaderDashes | |
| TabLeaderAsString = RID_STR_WORD_ENUMERATION_INDEX_LEADER_DASHES | |
| Case wdTabLeaderDots | |
| TabLeaderAsString = RID_STR_WORD_ENUMERATION_INDEX_LEADER_DOTS | |
| Case wdTabLeaderHeavy | |
| TabLeaderAsString = RID_STR_WORD_ENUMERATION_INDEX_LEADER_HEAVY | |
| Case wdTabLeaderLines | |
| TabLeaderAsString = RID_STR_WORD_ENUMERATION_INDEX_LEADER_LINES | |
| Case wdTabLeaderMiddleDot | |
| TabLeaderAsString = RID_STR_WORD_ENUMERATION_INDEX_LEADER_MIDDLEDOT | |
| Case wdTabLeaderSpaces | |
| TabLeaderAsString = RID_STR_WORD_ENUMERATION_INDEX_LEADER_SPACES | |
| Case Else | |
| TabLeaderAsString = RID_STR_WORD_ENUMERATION_UNKNOWN | |
| End Select | |
| Dim FormatAsString As String | |
| Select Case currDoc.TablesOfAuthorities.Format | |
| Case wdTOAClassic | |
| FormatAsString = RID_STR_WORD_ENUMERATION_INDEX_TABLES_CLASSIC | |
| Case wdTOADistinctive | |
| FormatAsString = RID_STR_WORD_ENUMERATION_INDEX_TABLES_DISTINCTIVE | |
| Case wdTOAFormal | |
| FormatAsString = RID_STR_WORD_ENUMERATION_INDEX_TABLES_FORMAL | |
| Case wdTOASimple | |
| FormatAsString = RID_STR_WORD_ENUMERATION_INDEX_TABLES_SIMPLE | |
| Case wdTOATemplate | |
| FormatAsString = RID_STR_WORD_ENUMERATION_INDEX_TABLES_FROM_TEMPLATE | |
| Case Else | |
| FormatAsString = RID_STR_WORD_ENUMERATION_UNKNOWN | |
| End Select | |
| With myIssue | |
| .IssueID = CID_INDEX_AND_REFERENCES | |
| .IssueType = RID_STR_WORD_ISSUE_INDEX_AND_REFERENCES | |
| .SubType = RID_STR_WORD_SUBISSUE_TABLE_OF_AUTHORITIES | |
| .Location = .CLocationPage | |
| .IssueTypeXML = CSTR_ISSUE_INDEX_AND_REFERENCES | |
| .SubTypeXML = CSTR_SUBISSUE_TABLE_OF_AUTHORITIES | |
| .locationXML = .CXMLLocationPage | |
| .SubLocation = myRng.Information(wdActiveEndPageNumber) | |
| .Attributes.Add RID_STR_WORD_ATTRIBUTE_LEADER | |
| .Values.Add TabLeaderAsString | |
| AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_TOA_MIGRATE_AS_PLAIN_TEXT | |
| mAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) = _ | |
| mAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) + 1 | |
| End With | |
| mAnalysis.Issues.Add myIssue | |
| Set myIssue = Nothing | |
| Set myRng = Nothing | |
| Next | |
| FinalExit: | |
| Set myIssue = Nothing | |
| Set myRng = Nothing | |
| Exit Sub | |
| HandleErrors: | |
| WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source | |
| Resume FinalExit | |
| End Sub | |
| Sub Analyze_TOAField(myField As Field) | |
| On Error GoTo HandleErrors | |
| Dim currentFunctionName As String | |
| currentFunctionName = "Analyze_TOAField" | |
| Dim toa As TableOfAuthorities | |
| Dim myIssue As IssueInfo | |
| If myField.Type = wdFieldTOAEntry Then | |
| Set myIssue = New IssueInfo | |
| myField.Select | |
| With myIssue | |
| .IssueID = CID_FIELDS | |
| .IssueType = RID_STR_WORD_ISSUE_FIELDS | |
| .SubType = RID_STR_WORD_SUBISSUE_TABLE_OF_AUTHORITIES_FIELD | |
| .Location = .CLocationPage | |
| .IssueTypeXML = CSTR_ISSUE_FIELDS | |
| .SubTypeXML = CSTR_SUBISSUE_TABLE_OF_AUTHORITIES_FIELD | |
| .locationXML = .CXMLLocationPage | |
| .SubLocation = Selection.Information(wdActiveEndPageNumber) | |
| .Line = Selection.Information(wdFirstCharacterLineNumber) | |
| .column = Selection.Information(wdFirstCharacterColumnNumber) | |
| .Attributes.Add RID_STR_WORD_ATTRIBUTE_FIELD_TEXT | |
| .Values.Add myField.Code.Text | |
| AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_TOA_FIELD_LOST_ON_ROUNDTRIP | |
| mAnalysis.IssuesCountArray(CID_FIELDS) = _ | |
| mAnalysis.IssuesCountArray(CID_FIELDS) + 1 | |
| End With | |
| mAnalysis.Issues.Add myIssue | |
| Set myIssue = Nothing | |
| End If | |
| FinalExit: | |
| Set myIssue = Nothing | |
| Exit Sub | |
| HandleErrors: | |
| WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source | |
| Resume FinalExit | |
| End Sub | |
| Sub Analyze_Tables_Borders(currDoc As Document) | |
| On Error GoTo HandleErrors | |
| Dim currentFunctionName As String | |
| currentFunctionName = "Analyze_Tables_Borders" | |
| Dim myIssue As IssueInfo | |
| Set myIssue = New IssueInfo | |
| Dim aTable As Table | |
| Dim invalidBorders As String | |
| For Each aTable In currDoc.Tables | |
| invalidBorders = GetInvalidBorder(aTable) | |
| If invalidBorders <> "" Then | |
| aTable.Range.Select | |
| Set myIssue = New IssueInfo | |
| With myIssue | |
| .IssueID = CID_TABLES | |
| .IssueType = RID_STR_WORD_ISSUE_TABLES | |
| .SubType = RID_STR_WORD_SUBISSUE_BORDER_STYLES | |
| .Location = .CLocationPage | |
| .IssueTypeXML = CSTR_ISSUE_TABLES | |
| .SubTypeXML = CSTR_SUBISSUE_BORDER_STYLES | |
| .locationXML = .CXMLLocationPage | |
| .SubLocation = Selection.Information(wdActiveEndPageNumber) | |
| .Line = Selection.Information(wdFirstCharacterLineNumber) | |
| .column = Selection.Information(wdFirstCharacterColumnNumber) | |
| .Attributes.Add RID_STR_WORD_ATTRIBUTE_BORDERS_NOT_DISPLAYING | |
| .Values.Add invalidBorders | |
| AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_TABLE_BORDER | |
| mAnalysis.IssuesCountArray(CID_TABLES) = mAnalysis.IssuesCountArray(CID_TABLES) + 1 | |
| End With | |
| mAnalysis.Issues.Add myIssue | |
| Set myIssue = Nothing | |
| End If | |
| Next aTable | |
| FinalExit: | |
| Set myIssue = Nothing | |
| Exit Sub | |
| HandleErrors: | |
| WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source | |
| Resume FinalExit | |
| End Sub | |
| Function GetInvalidBorder(aTable As Table) As String | |
| Dim theResult As String | |
| theResult = "" | |
| If IsInvalidBorderStyle(aTable.Borders(wdBorderTop).LineStyle) Then | |
| theResult = theResult + "Top, " | |
| End If | |
| If IsInvalidBorderStyle(aTable.Borders(wdBorderBottom).LineStyle) Then | |
| theResult = theResult + "Bottom, " | |
| End If | |
| If IsInvalidBorderStyle(aTable.Borders(wdBorderDiagonalDown).LineStyle) Then | |
| theResult = theResult + "Down Diagonal, " | |
| End If | |
| If IsInvalidBorderStyle(aTable.Borders(wdBorderDiagonalUp).LineStyle) Then | |
| theResult = theResult + "Up Diagonal, " | |
| End If | |
| If IsInvalidBorderStyle(aTable.Borders(wdBorderHorizontal).LineStyle) Then | |
| theResult = theResult + "Horizontal, " | |
| End If | |
| If IsInvalidBorderStyle(aTable.Borders(wdBorderLeft).LineStyle) Then | |
| theResult = theResult + "Left, " | |
| End If | |
| If IsInvalidBorderStyle(aTable.Borders(wdBorderRight).LineStyle) Then | |
| theResult = theResult + "Right, " | |
| End If | |
| If IsInvalidBorderStyle(aTable.Borders(wdBorderVertical).LineStyle) Then | |
| theResult = theResult + "Vertical, " | |
| End If | |
| If theResult <> "" Then | |
| theResult = Left(theResult, (Len(theResult) - 2)) + "." | |
| End If | |
| GetInvalidBorder = theResult | |
| End Function | |
| Function IsInvalidBorderStyle(aStyle As WdLineStyle) As Boolean | |
| Dim IsInvalid As Boolean | |
| Select Case aStyle | |
| Case wdLineStyleDot, wdLineStyleDashSmallGap, wdLineStyleDashLargeGap, wdLineStyleDashDot, _ | |
| wdLineStyleDashDotDot, wdLineStyleTriple, wdLineStyleThinThickThinSmallGap, wdLineStyleThinThickMedGap, _ | |
| wdLineStyleThickThinMedGap, wdLineStyleThinThickThinMedGap, wdLineStyleThinThickLargeGap, _ | |
| wdLineStyleThickThinLargeGap, wdLineStyleThinThickThinLargeGap, wdLineStyleSingleWavy, _ | |
| wdLineStyleDoubleWavy, wdLineStyleDashDotStroked, wdLineStyleEmboss3D, wdLineStyleEngrave3D | |
| IsInvalid = True | |
| Case Else | |
| IsInvalid = False | |
| End Select | |
| IsInvalidBorderStyle = IsInvalid | |
| End Function | |
| Private Sub Class_Initialize() | |
| Set mAnalysis = New DocumentAnalysis | |
| End Sub | |
| Private Sub Class_Terminate() | |
| Set mAnalysis = Nothing | |
| End Sub | |
| Public Property Get Results() As DocumentAnalysis | |
| Set Results = mAnalysis | |
| End Property | |
| Sub Analyze_NumberingTabs(currDoc As Document, docAnalysis As DocumentAnalysis) | |
| On Error GoTo HandleErrors | |
| Dim currentFunctionName As String | |
| currentFunctionName = "Analyze_NumberingTabs" | |
| Dim tb As TabStop | |
| Dim customTabPos As Single | |
| Dim tabs As Integer | |
| Dim listLvl As Long | |
| Dim tp As Single | |
| Dim bHasAlignmentProblem As Boolean | |
| Dim bHasTooManyTabs As Boolean | |
| Dim myIssue As IssueInfo | |
| Dim p As Object | |
| bHasAlignmentProblem = False | |
| bHasTooManyTabs = False | |
| For Each p In currDoc.ListParagraphs | |
| tabs = 0 | |
| For Each tb In p.TabStops | |
| If tb.customTab Then | |
| tabs = tabs + 1 | |
| customTabPos = tb.Position | |
| End If | |
| Next | |
| If tabs = 1 Then | |
| listLvl = p.Range.ListFormat.ListLevelNumber | |
| tp = p.Range.ListFormat.ListTemplate.ListLevels.item(listLvl).TabPosition | |
| If (p.Range.ListFormat.ListTemplate.ListLevels.item(listLvl).Alignment <> _ | |
| wdListLevelAlignLeft) Then | |
| ' ERROR: alignment problem | |
| bHasAlignmentProblem = True | |
| End If | |
| If tp <> customTabPos Then | |
| p.Range.InsertBefore ("XXXXX") | |
| End If | |
| 'OK - at least heuristically | |
| Else | |
| 'ERROR: too many tabs | |
| bHasTooManyTabs = True | |
| End If | |
| Next | |
| If (bHasAlignmentProblem) Then | |
| Set myIssue = New IssueInfo | |
| With myIssue | |
| .IssueID = CID_INDEX_AND_REFERENCES | |
| .IssueType = RID_STR_WORD_ISSUE_INDEX_AND_REFERENCES | |
| .SubType = RID_STR_WORD_SUBISSUE_NUMBERING_TAB_ALIGNMENT | |
| .Location = .CLocationDocument 'Location string | |
| .IssueTypeXML = CSTR_ISSUE_INDEX_AND_REFERENCES | |
| .SubTypeXML = CSTR_SUBISSUE_NUMBERING_TAB_ALIGNMENT | |
| .locationXML = .CXMLLocationDocument | |
| AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_NUMBERING_TAB_ALIGNMENT | |
| docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) = _ | |
| docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) + 1 | |
| End With | |
| docAnalysis.Issues.Add myIssue | |
| Set myIssue = Nothing | |
| End If | |
| If (bHasTooManyTabs) Then | |
| Set myIssue = New IssueInfo | |
| With myIssue | |
| .IssueID = CID_INDEX_AND_REFERENCES | |
| .IssueType = RID_STR_WORD_ISSUE_INDEX_AND_REFERENCES | |
| .SubType = RID_STR_WORD_SUBISSUE_NUMBERING_TAB_OVERFLOW | |
| .Location = .CLocationDocument 'Location string | |
| .IssueTypeXML = CSTR_ISSUE_INDEX_AND_REFERENCES | |
| .SubTypeXML = CSTR_SUBISSUE_NUMBERING_TAB_OVERFLOW | |
| .locationXML = .CXMLLocationDocument | |
| AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_NUMBERING_TAB_OVERFLOW | |
| docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) = _ | |
| docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) + 1 | |
| End With | |
| docAnalysis.Issues.Add myIssue | |
| Set myIssue = Nothing | |
| End If | |
| FinalExit: | |
| Exit Sub | |
| HandleErrors: | |
| WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source | |
| Set myIssue = Nothing | |
| Resume FinalExit | |
| End Sub | |
| Sub Analyze_Numbering(currDoc As Document, docAnalysis As DocumentAnalysis) | |
| On Error GoTo HandleErrors | |
| Dim currentFunctionName As String | |
| currentFunctionName = "Analyze_Numbering" | |
| Dim myIssue As IssueInfo | |
| Dim nFormatProblems As Integer | |
| Dim nAlignmentProblems As Integer | |
| nFormatProblems = 0 | |
| nAlignmentProblems = 0 | |
| Dim lt As ListTemplate | |
| Dim lvl As ListLevel | |
| Dim I, l_, p1, p2, v1, v2 As Integer | |
| Dim display_levels As Integer | |
| Dim fmt, prefix, postfix, res As String | |
| For Each lt In currDoc.ListTemplates | |
| l_ = 0 | |
| For Each lvl In lt.ListLevels | |
| l_ = l_ + 1 | |
| 'Selection.TypeText Text:="List Number Format " + lvl.NumberFormat | |
| 'Apply Heuristic | |
| fmt = lvl.NumberFormat | |
| p1 = InStr(fmt, "%") | |
| p2 = InStrRev(fmt, "%") | |
| v1 = val(Mid(fmt, p1 + 1, 1)) | |
| v2 = val(Mid(fmt, p2 + 1, 1)) | |
| display_levels = v2 - v1 + 1 | |
| prefix = Mid(fmt, 1, p1 - 1) | |
| postfix = Mid(fmt, p2 + 2) | |
| 'Check Heuristic | |
| res = prefix | |
| For I = 2 To display_levels | |
| res = "%" + Trim(Str(l_ - I + 1)) + "." + res | |
| Next | |
| res = res + "%" + Trim(Str(l_)) + postfix | |
| If (StrComp(res, fmt) <> 0) Then | |
| nFormatProblems = nFormatProblems + 1 | |
| 'Selection.TypeText Text:="Label Problem: NumberFormat=" + fmt + " Heuristic=" + res | |
| End If | |
| 'check alignment | |
| If (lvl.NumberPosition <> wdListLevelAlignLeft) Then | |
| nAlignmentProblems = nAlignmentProblems + 1 | |
| 'Selection.TypeText Text:="Number alignment problem" | |
| End If | |
| Next | |
| Next | |
| If (nFormatProblems > 0) Then | |
| Set myIssue = New IssueInfo | |
| With myIssue | |
| .IssueID = CID_INDEX_AND_REFERENCES | |
| .IssueType = RID_STR_WORD_ISSUE_INDEX_AND_REFERENCES | |
| .SubType = RID_STR_WORD_SUBISSUE_NUMBERING_FORMAT | |
| .Location = .CLocationDocument 'Location string | |
| .IssueTypeXML = CSTR_ISSUE_INDEX_AND_REFERENCES | |
| .SubTypeXML = CSTR_SUBISSUE_NUMBERING_FORMAT | |
| .locationXML = .CXMLLocationDocument | |
| .Attributes.Add RID_STR_WORD_ATTRIBUTE_COUNT | |
| .Values.Add nFormatProblems | |
| AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_NUMBERING_FORMAT | |
| docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) = _ | |
| docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) + 1 | |
| End With | |
| docAnalysis.Issues.Add myIssue | |
| Set myIssue = Nothing | |
| End If | |
| If (nAlignmentProblems > 0) Then | |
| Set myIssue = New IssueInfo | |
| With myIssue | |
| .IssueID = CID_INDEX_AND_REFERENCES | |
| .IssueType = RID_STR_WORD_ISSUE_INDEX_AND_REFERENCES | |
| .SubType = RID_STR_WORD_SUBISSUE_NUMBERING_ALIGNMENT | |
| .Location = .CLocationDocument 'Location string | |
| .IssueTypeXML = CSTR_ISSUE_INDEX_AND_REFERENCES | |
| .SubTypeXML = CSTR_SUBISSUE_NUMBERING_ALIGNMENT | |
| .locationXML = .CXMLLocationDocument | |
| .Attributes.Add RID_STR_WORD_ATTRIBUTE_COUNT | |
| .Values.Add nAlignmentProblems | |
| AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_NUMBERING_ALIGNMENT | |
| docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) = _ | |
| docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) + 1 | |
| End With | |
| docAnalysis.Issues.Add myIssue | |
| Set myIssue = Nothing | |
| End If | |
| FinalExit: | |
| Exit Sub | |
| HandleErrors: | |
| WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source | |
| Set myIssue = Nothing | |
| Resume FinalExit | |
| End Sub | |