You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@openoffice.apache.org by pf...@apache.org on 2014/04/29 21:12:03 UTC
svn commit: r1591060 [7/15] - in /openoffice/trunk/main:
helpcontent2/source/text/scalc/01/ helpcontent2/source/text/shared/01/
helpcontent2/source/text/simpress/01/ helpcontent2/source/text/smath/01/
helpcontent2/source/text/swriter/01/ helpcontent2/s...
Modified: openoffice/trunk/main/migrationanalysis/src/driver_docs/sources/word/MigrationAnalyser.cls
URL: http://svn.apache.org/viewvc/openoffice/trunk/main/migrationanalysis/src/driver_docs/sources/word/MigrationAnalyser.cls?rev=1591060&r1=1591059&r2=1591060&view=diff
==============================================================================
--- openoffice/trunk/main/migrationanalysis/src/driver_docs/sources/word/MigrationAnalyser.cls (original)
+++ openoffice/trunk/main/migrationanalysis/src/driver_docs/sources/word/MigrationAnalyser.cls Tue Apr 29 19:11:53 2014
@@ -1,1518 +1,1518 @@
-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
-
+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 separate 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
[... 774 lines stripped ...]