1*b1cdbd2cSJim JagielskiAttribute VB_Name = "CommonMigrationAnalyser" 2*b1cdbd2cSJim Jagielski'************************************************************************* 3*b1cdbd2cSJim Jagielski' 4*b1cdbd2cSJim Jagielski' Licensed to the Apache Software Foundation (ASF) under one 5*b1cdbd2cSJim Jagielski' or more contributor license agreements. See the NOTICE file 6*b1cdbd2cSJim Jagielski' distributed with this work for additional information 7*b1cdbd2cSJim Jagielski' regarding copyright ownership. The ASF licenses this file 8*b1cdbd2cSJim Jagielski' to you under the Apache License, Version 2.0 (the 9*b1cdbd2cSJim Jagielski' "License"); you may not use this file except in compliance 10*b1cdbd2cSJim Jagielski' with the License. You may obtain a copy of the License at 11*b1cdbd2cSJim Jagielski' 12*b1cdbd2cSJim Jagielski' http://www.apache.org/licenses/LICENSE-2.0 13*b1cdbd2cSJim Jagielski' 14*b1cdbd2cSJim Jagielski' Unless required by applicable law or agreed to in writing, 15*b1cdbd2cSJim Jagielski' software distributed under the License is distributed on an 16*b1cdbd2cSJim Jagielski' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 17*b1cdbd2cSJim Jagielski' KIND, either express or implied. See the License for the 18*b1cdbd2cSJim Jagielski' specific language governing permissions and limitations 19*b1cdbd2cSJim Jagielski' under the License. 20*b1cdbd2cSJim Jagielski' 21*b1cdbd2cSJim Jagielski'************************************************************************* 22*b1cdbd2cSJim JagielskiOption Explicit 23*b1cdbd2cSJim Jagielski 24*b1cdbd2cSJim Jagielski 25*b1cdbd2cSJim Jagielski'*********************************************** 26*b1cdbd2cSJim Jagielski'**** APPLICATION COMMON ANALYSIS FUNCTIONS **** 27*b1cdbd2cSJim Jagielski'*********************************************** 28*b1cdbd2cSJim Jagielski 29*b1cdbd2cSJim Jagielski'** Common - XML Issue and SubIssue strings 30*b1cdbd2cSJim Jagielski'For preparation - need access to some Word/ Excel or PP consts 31*b1cdbd2cSJim JagielskiPublic Const CSTR_ISSUE_OBJECTS_GRAPHICS_AND_FRAMES = "ObjectsGraphicsAndFrames" 32*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_OBJECT_IN_HEADER_FOOTER = "ObjectInHeaderFooter" 33*b1cdbd2cSJim Jagielski 34*b1cdbd2cSJim JagielskiPublic Const CSTR_ISSUE_INFORMATION = "Information" 35*b1cdbd2cSJim JagielskiPublic Const CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES = "ContentAndDocumentProperties" 36*b1cdbd2cSJim JagielskiPublic Const CSTR_ISSUE_FORMAT = "Format" 37*b1cdbd2cSJim JagielskiPublic Const CSTR_ISSUE_PORTABILITY = "Portability" 38*b1cdbd2cSJim JagielskiPublic Const CSTR_ISSUE_VBA_MACROS = "VBAMacros" 39*b1cdbd2cSJim Jagielski 40*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_DOCUMENT_PARTS_PROTECTION = "DocumentPartsProtection" 41*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_EXTERNAL_REFERENCES_IN_MACRO = "ExternalReferencesInMacro" 42*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_EXTERNAL_REFERENCES_IN_MACRO_COUNT = "ExternalReferencesInMacroCount" 43*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_GRADIENT = "Gradient" 44*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_INVALID_PASSWORD_ENTERED = "InvalidPasswordEntered" 45*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_LINE = "Line" 46*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_MACRO_PASSWORD_PROTECTION = "PasswordProtected" 47*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_OLD_WORKBOOK_VERSION = "OldWorkbookVersion" 48*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_OLE_EMBEDDED = "EmbeddedOLEObject" 49*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_OLE_LINKED = "LinkedOLEObject" 50*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_OLE_CONTROL = "OLEControl" 51*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_OLE_FIELD_LINK = "OLEFieldLink" 52*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_OLE_UNKNOWN = "UnknownType" 53*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_PASSWORDS_PROTECTION = "PasswordProtection" 54*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_PROPERTIES = "Properties" 55*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_REFERENCES = "References" 56*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_TRANSPARENCY = "Transparency" 57*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_VBA_MACROS_NUMLINES = "NumberOfLines" 58*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_VBA_MACROS_USERFORMS_COUNT = "UserFormsCount" 59*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_VBA_MACROS_USERFORMS_CONTROL_COUNT = "UserFormsControlCount" 60*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_VBA_MACROS_USERFORMS_CONTROLTYPE_COUNT = "UserFormsControlTypeCount" 61*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_VBA_MACROS_UNIQUE_MODULE_COUNT = "UniqueModuleCount" 62*b1cdbd2cSJim JagielskiPublic Const CSTR_SUBISSUE_VBA_MACROS_UNIQUE_LINE_COUNT = "UniqueLineCount" 63*b1cdbd2cSJim Jagielski'** END Common - XML Issue and SubIssue strings 64*b1cdbd2cSJim Jagielski 65*b1cdbd2cSJim Jagielski'Macro classification bounds 66*b1cdbd2cSJim JagielskiPublic Const CMACRO_LINECOUNT_MEDIUM_LBOUND = 50 67*b1cdbd2cSJim Jagielski 68*b1cdbd2cSJim Jagielski'Don't localize folder name 69*b1cdbd2cSJim JagielskiPublic Const CSTR_COMMON_PREPARATION_FOLDER = "prepared" 70*b1cdbd2cSJim Jagielski 71*b1cdbd2cSJim Jagielski 72*b1cdbd2cSJim JagielskiPublic Enum EnumDocOverallMacroClass 73*b1cdbd2cSJim Jagielski enMacroNone = 0 74*b1cdbd2cSJim Jagielski enMacroSimple = 1 75*b1cdbd2cSJim Jagielski enMacroMedium = 2 76*b1cdbd2cSJim Jagielski enMacroComplex = 3 77*b1cdbd2cSJim JagielskiEnd Enum 78*b1cdbd2cSJim JagielskiPublic Enum EnumDocOverallIssueClass 79*b1cdbd2cSJim Jagielski enNone = 0 80*b1cdbd2cSJim Jagielski enMinor = 1 81*b1cdbd2cSJim Jagielski enComplex = 2 82*b1cdbd2cSJim JagielskiEnd Enum 83*b1cdbd2cSJim Jagielski 84*b1cdbd2cSJim JagielskiSub EmptyCollection(docAnalysis As DocumentAnalysis, coll As Collection) 85*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 86*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 87*b1cdbd2cSJim Jagielski currentFunctionName = "EmptyCollection" 88*b1cdbd2cSJim Jagielski Dim Num As Long 89*b1cdbd2cSJim Jagielski For Num = 1 To coll.count ' Remove name from the collection. 90*b1cdbd2cSJim Jagielski coll.Remove 1 ' Default collection numeric indexes 91*b1cdbd2cSJim Jagielski Next ' begin at 1. 92*b1cdbd2cSJim Jagielski Exit Sub 93*b1cdbd2cSJim Jagielski 94*b1cdbd2cSJim JagielskiHandleErrors: 95*b1cdbd2cSJim Jagielski WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 96*b1cdbd2cSJim JagielskiEnd Sub 97*b1cdbd2cSJim Jagielski 98*b1cdbd2cSJim JagielskiPublic Function Analyze_Macros(docAnalysis As DocumentAnalysis, _ 99*b1cdbd2cSJim Jagielski userFormTypesDict As Scripting.Dictionary, _ 100*b1cdbd2cSJim Jagielski currDoc As Object) 101*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 102*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 103*b1cdbd2cSJim Jagielski currentFunctionName = "Analyze_Macros" 104*b1cdbd2cSJim Jagielski Dim macroDetails As String 105*b1cdbd2cSJim Jagielski Dim cmpDetails As String 106*b1cdbd2cSJim Jagielski Dim myProject As VBProject 107*b1cdbd2cSJim Jagielski Dim myComponent As VBComponent 108*b1cdbd2cSJim Jagielski Dim numLines As Long 109*b1cdbd2cSJim Jagielski Dim myIssue As IssueInfo 110*b1cdbd2cSJim Jagielski Dim wrd As Object 111*b1cdbd2cSJim Jagielski Dim bUserFormWithEmptyCodeModule As Boolean 112*b1cdbd2cSJim Jagielski 113*b1cdbd2cSJim Jagielski On Error Resume Next 114*b1cdbd2cSJim Jagielski Set myProject = getAppSpecificVBProject(currDoc) 115*b1cdbd2cSJim Jagielski If Err.Number <> 0 Then 116*b1cdbd2cSJim Jagielski ' Failed to get access to VBProject 117*b1cdbd2cSJim Jagielski WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & _ 118*b1cdbd2cSJim Jagielski RID_STR_COMMON_ATTRIBUTE_UNABLE_TO_ACCESS_VBPROJECT & ":" & _ 119*b1cdbd2cSJim Jagielski RID_STR_COMMON_ATTRIBUTE_FURTHER_MACRO_ANALYSIS_NOT_POSSIBLE 120*b1cdbd2cSJim Jagielski 121*b1cdbd2cSJim Jagielski GoTo FinalExit 122*b1cdbd2cSJim Jagielski End If 123*b1cdbd2cSJim Jagielski 124*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 125*b1cdbd2cSJim Jagielski If myProject.Protection = vbext_pp_locked Then 126*b1cdbd2cSJim Jagielski Set myIssue = New IssueInfo 127*b1cdbd2cSJim Jagielski With myIssue 128*b1cdbd2cSJim Jagielski .IssueID = CID_VBA_MACROS 129*b1cdbd2cSJim Jagielski .IssueType = RID_STR_COMMON_ISSUE_VBA_MACROS 130*b1cdbd2cSJim Jagielski .SubType = RID_STR_COMMON_SUBISSUE_MACRO_PASSWORD_PROTECTION 131*b1cdbd2cSJim Jagielski .Location = .CLocationDocument 132*b1cdbd2cSJim Jagielski 133*b1cdbd2cSJim Jagielski .IssueTypeXML = CSTR_ISSUE_VBA_MACROS 134*b1cdbd2cSJim Jagielski .SubTypeXML = CSTR_SUBISSUE_MACRO_PASSWORD_PROTECTION 135*b1cdbd2cSJim Jagielski .locationXML = .CXMLLocationDocument 136*b1cdbd2cSJim Jagielski 137*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_VBPROJECT_PASSWORD 138*b1cdbd2cSJim Jagielski .Values.Add RID_STR_COMMON_ATTRIBUTE_FURTHER_MACRO_ANALYSIS_NOT_POSSIBLE 139*b1cdbd2cSJim Jagielski End With 140*b1cdbd2cSJim Jagielski docAnalysis.IssuesCountArray(CID_VBA_MACROS) = _ 141*b1cdbd2cSJim Jagielski docAnalysis.IssuesCountArray(CID_VBA_MACROS) + 1 142*b1cdbd2cSJim Jagielski docAnalysis.Issues.Add myIssue 143*b1cdbd2cSJim Jagielski docAnalysis.MacroIssuesCount = docAnalysis.MacroIssuesCount + 1 144*b1cdbd2cSJim Jagielski 145*b1cdbd2cSJim Jagielski docAnalysis.HasMacros = True 146*b1cdbd2cSJim Jagielski GoTo FinalExit 147*b1cdbd2cSJim Jagielski End If 148*b1cdbd2cSJim Jagielski 149*b1cdbd2cSJim Jagielski Dim myContolDict As Scripting.Dictionary 150*b1cdbd2cSJim Jagielski For Each myComponent In myProject.VBComponents 151*b1cdbd2cSJim Jagielski 152*b1cdbd2cSJim Jagielski bUserFormWithEmptyCodeModule = False 153*b1cdbd2cSJim Jagielski If CheckEmptyProject(docAnalysis, myProject, myComponent) Then 154*b1cdbd2cSJim Jagielski If myComponent.Type <> vbext_ct_MSForm Then 155*b1cdbd2cSJim Jagielski GoTo FOREACH_CONTINUE 156*b1cdbd2cSJim Jagielski Else 157*b1cdbd2cSJim Jagielski bUserFormWithEmptyCodeModule = True 158*b1cdbd2cSJim Jagielski End If 159*b1cdbd2cSJim Jagielski End If 160*b1cdbd2cSJim Jagielski 161*b1cdbd2cSJim Jagielski Analyze_MacrosForPortabilityIssues docAnalysis, myProject, myComponent 162*b1cdbd2cSJim Jagielski 163*b1cdbd2cSJim Jagielski Set myIssue = New IssueInfo 164*b1cdbd2cSJim Jagielski With myIssue 165*b1cdbd2cSJim Jagielski .IssueID = CID_VBA_MACROS 166*b1cdbd2cSJim Jagielski .IssueType = RID_STR_COMMON_ISSUE_VBA_MACROS 167*b1cdbd2cSJim Jagielski .SubType = RID_STR_COMMON_SUBISSUE_PROPERTIES 168*b1cdbd2cSJim Jagielski .Location = .CLocationDocument 169*b1cdbd2cSJim Jagielski 170*b1cdbd2cSJim Jagielski .IssueTypeXML = CSTR_ISSUE_VBA_MACROS 171*b1cdbd2cSJim Jagielski .SubTypeXML = CSTR_SUBISSUE_PROPERTIES 172*b1cdbd2cSJim Jagielski .locationXML = .CXMLLocationDocument 173*b1cdbd2cSJim Jagielski 174*b1cdbd2cSJim Jagielski .SubLocation = VBComponentType(myComponent) 175*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_PROJECT 176*b1cdbd2cSJim Jagielski .Values.Add myProject.name 177*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_COMPONENT 178*b1cdbd2cSJim Jagielski .Values.Add myComponent.name 179*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_PROCEDURES 180*b1cdbd2cSJim Jagielski .Values.Add VBNumFuncs(docAnalysis, myComponent.CodeModule), RID_STR_COMMON_ATTRIBUTE_PROCEDURES 181*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NUMBER_OF_LINES 182*b1cdbd2cSJim Jagielski numLines = VBNumLines(docAnalysis, myComponent.CodeModule) 183*b1cdbd2cSJim Jagielski .Values.Add numLines, RID_STR_COMMON_ATTRIBUTE_NUMBER_OF_LINES 184*b1cdbd2cSJim Jagielski 185*b1cdbd2cSJim Jagielski If bUserFormWithEmptyCodeModule Then 186*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_SIGNATURE 187*b1cdbd2cSJim Jagielski .Values.Add RID_STR_COMMON_NA, RID_STR_COMMON_ATTRIBUTE_SIGNATURE 188*b1cdbd2cSJim Jagielski Else 189*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_SIGNATURE 190*b1cdbd2cSJim Jagielski .Values.Add MD5HashString( _ 191*b1cdbd2cSJim Jagielski myComponent.CodeModule.Lines(1, myComponent.CodeModule.CountOfLines)), _ 192*b1cdbd2cSJim Jagielski RID_STR_COMMON_ATTRIBUTE_SIGNATURE 193*b1cdbd2cSJim Jagielski End If 194*b1cdbd2cSJim Jagielski 195*b1cdbd2cSJim Jagielski docAnalysis.MacroTotalNumLines = numLines + docAnalysis.MacroTotalNumLines 196*b1cdbd2cSJim Jagielski End With 197*b1cdbd2cSJim Jagielski 198*b1cdbd2cSJim Jagielski ' User Forms - control details 199*b1cdbd2cSJim Jagielski If (myComponent.Type = vbext_ct_MSForm) And Not bUserFormWithEmptyCodeModule Then 200*b1cdbd2cSJim Jagielski myIssue.Attributes.Add RID_STR_COMMON_ATTRIBUTE_CONTROLS 201*b1cdbd2cSJim Jagielski myIssue.Values.Add myComponent.Designer.Controls.count, RID_STR_COMMON_ATTRIBUTE_CONTROLS 202*b1cdbd2cSJim Jagielski docAnalysis.MacroNumUserForms = 1 + docAnalysis.MacroNumUserForms 203*b1cdbd2cSJim Jagielski docAnalysis.MacroNumUserFormControls = myComponent.Designer.Controls.count + docAnalysis.MacroNumUserFormControls 204*b1cdbd2cSJim Jagielski 205*b1cdbd2cSJim Jagielski Dim myControl As Control 206*b1cdbd2cSJim Jagielski Dim controlTypes As String 207*b1cdbd2cSJim Jagielski Dim myType As String 208*b1cdbd2cSJim Jagielski 209*b1cdbd2cSJim Jagielski Set myContolDict = New Scripting.Dictionary 210*b1cdbd2cSJim Jagielski 211*b1cdbd2cSJim Jagielski For Each myControl In myComponent.Designer.Controls 212*b1cdbd2cSJim Jagielski myType = TypeName(myControl) 213*b1cdbd2cSJim Jagielski If myContolDict.Exists(myType) Then 214*b1cdbd2cSJim Jagielski myContolDict.item(myType) = myContolDict.item(myType) + 1 215*b1cdbd2cSJim Jagielski Else 216*b1cdbd2cSJim Jagielski myContolDict.Add myType, 1 217*b1cdbd2cSJim Jagielski End If 218*b1cdbd2cSJim Jagielski If userFormTypesDict.Exists(myType) Then 219*b1cdbd2cSJim Jagielski userFormTypesDict.item(myType) = userFormTypesDict.item(myType) + 1 220*b1cdbd2cSJim Jagielski Else 221*b1cdbd2cSJim Jagielski userFormTypesDict.Add myType, 1 222*b1cdbd2cSJim Jagielski End If 223*b1cdbd2cSJim Jagielski Next 224*b1cdbd2cSJim Jagielski 225*b1cdbd2cSJim Jagielski If myComponent.Designer.Controls.count > 0 Then 226*b1cdbd2cSJim Jagielski Dim count As Long 227*b1cdbd2cSJim Jagielski Dim vKeyArray As Variant 228*b1cdbd2cSJim Jagielski Dim vItemArray As Variant 229*b1cdbd2cSJim Jagielski 230*b1cdbd2cSJim Jagielski vKeyArray = myContolDict.Keys 231*b1cdbd2cSJim Jagielski vItemArray = myContolDict.Items 232*b1cdbd2cSJim Jagielski 233*b1cdbd2cSJim Jagielski controlTypes = "" 234*b1cdbd2cSJim Jagielski For count = 0 To myContolDict.count - 1 235*b1cdbd2cSJim Jagielski controlTypes = controlTypes & vKeyArray(count) & " " & CInt(vItemArray(count)) & " " 236*b1cdbd2cSJim Jagielski Next count 237*b1cdbd2cSJim Jagielski myIssue.Attributes.Add RID_STR_COMMON_ATTRIBUTE_USERFORM_TYPE 238*b1cdbd2cSJim Jagielski myIssue.Values.Add controlTypes, RID_STR_COMMON_ATTRIBUTE_USERFORM_TYPE 239*b1cdbd2cSJim Jagielski 240*b1cdbd2cSJim Jagielski myIssue.Attributes.Add RID_STR_COMMON_ATTRIBUTE_USERFORM_TYPES_COUNT 241*b1cdbd2cSJim Jagielski myIssue.Values.Add myContolDict.count, RID_STR_COMMON_ATTRIBUTE_USERFORM_TYPES_COUNT 242*b1cdbd2cSJim Jagielski 243*b1cdbd2cSJim Jagielski docAnalysis.MacroNumUserFormControlTypes = myContolDict.count + docAnalysis.MacroNumUserFormControlTypes 244*b1cdbd2cSJim Jagielski End If 245*b1cdbd2cSJim Jagielski Set myContolDict = Nothing 246*b1cdbd2cSJim Jagielski End If 247*b1cdbd2cSJim Jagielski 248*b1cdbd2cSJim Jagielski 'Check for occurence of " Me " in Form and Class Modules 249*b1cdbd2cSJim Jagielski If myComponent.Type = vbext_ct_MSForm Or _ 250*b1cdbd2cSJim Jagielski myComponent.Type = vbext_ct_ClassModule Then 251*b1cdbd2cSJim Jagielski 252*b1cdbd2cSJim Jagielski Dim strFind As String 253*b1cdbd2cSJim Jagielski strFind = "" 254*b1cdbd2cSJim Jagielski count = 0 255*b1cdbd2cSJim Jagielski strFind = VBFindLines(docAnalysis, myComponent.CodeModule, "Me", count, bWholeWord:=True) 256*b1cdbd2cSJim Jagielski' If (strFind <> "") Then MsgBox strFind 257*b1cdbd2cSJim Jagielski 258*b1cdbd2cSJim Jagielski If count > 0 Then 259*b1cdbd2cSJim Jagielski myIssue.Attributes.Add RID_STR_COMMON_ATTRIBUTE_CLASS_ME_COUNT 260*b1cdbd2cSJim Jagielski myIssue.Values.Add count, RID_STR_COMMON_ATTRIBUTE_CLASS_ME_COUNT 261*b1cdbd2cSJim Jagielski End If 262*b1cdbd2cSJim Jagielski End If 263*b1cdbd2cSJim Jagielski 264*b1cdbd2cSJim Jagielski docAnalysis.IssuesCountArray(CID_VBA_MACROS) = _ 265*b1cdbd2cSJim Jagielski docAnalysis.IssuesCountArray(CID_VBA_MACROS) + 1 266*b1cdbd2cSJim Jagielski docAnalysis.Issues.Add myIssue 267*b1cdbd2cSJim Jagielski docAnalysis.MacroIssuesCount = docAnalysis.MacroIssuesCount + 1 268*b1cdbd2cSJim Jagielski 269*b1cdbd2cSJim Jagielski Set myIssue = Nothing 270*b1cdbd2cSJim Jagielski 271*b1cdbd2cSJim JagielskiFOREACH_CONTINUE: 272*b1cdbd2cSJim Jagielski 'No equiv to C continue in VB 273*b1cdbd2cSJim Jagielski Next myComponent 'End - For Each myComponent 274*b1cdbd2cSJim Jagielski 275*b1cdbd2cSJim Jagielski If docAnalysis.IssuesCountArray(CID_VBA_MACROS) > 0 Then 276*b1cdbd2cSJim Jagielski Analyze_VBEReferences docAnalysis, currDoc 277*b1cdbd2cSJim Jagielski docAnalysis.HasMacros = True 278*b1cdbd2cSJim Jagielski End If 279*b1cdbd2cSJim Jagielski 280*b1cdbd2cSJim JagielskiFinalExit: 281*b1cdbd2cSJim Jagielski docAnalysis.MacroOverallClass = ClassifyDocOverallMacroClass(docAnalysis) 282*b1cdbd2cSJim Jagielski 283*b1cdbd2cSJim Jagielski Set myProject = Nothing 284*b1cdbd2cSJim Jagielski Set myIssue = Nothing 285*b1cdbd2cSJim Jagielski Set myContolDict = Nothing 286*b1cdbd2cSJim Jagielski Exit Function 287*b1cdbd2cSJim Jagielski 288*b1cdbd2cSJim JagielskiHandleErrors: 289*b1cdbd2cSJim Jagielski WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 290*b1cdbd2cSJim Jagielski Resume FinalExit 291*b1cdbd2cSJim JagielskiEnd Function 292*b1cdbd2cSJim Jagielski 293*b1cdbd2cSJim JagielskiFunction CheckOnlyEmptyProject(docAnalysis As DocumentAnalysis, currDoc As Object) As Boolean 294*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 295*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 296*b1cdbd2cSJim Jagielski currentFunctionName = "CheckOnlyEmptyProject" 297*b1cdbd2cSJim Jagielski Dim myProject As VBProject 298*b1cdbd2cSJim Jagielski Set myProject = getAppSpecificVBProject(currDoc) 299*b1cdbd2cSJim Jagielski Dim myVBComponent As VBComponent 300*b1cdbd2cSJim Jagielski 301*b1cdbd2cSJim Jagielski For Each myVBComponent In myProject.VBComponents 302*b1cdbd2cSJim Jagielski If Not CheckEmptyProject(docAnalysis, myProject, myVBComponent) Then 303*b1cdbd2cSJim Jagielski CheckOnlyEmptyProject = False 304*b1cdbd2cSJim Jagielski GoTo FinalExit 305*b1cdbd2cSJim Jagielski End If 306*b1cdbd2cSJim Jagielski Next myVBComponent 307*b1cdbd2cSJim Jagielski 308*b1cdbd2cSJim Jagielski CheckOnlyEmptyProject = True 309*b1cdbd2cSJim Jagielski 310*b1cdbd2cSJim JagielskiFinalExit: 311*b1cdbd2cSJim Jagielski Set myProject = Nothing 312*b1cdbd2cSJim Jagielski Exit Function 313*b1cdbd2cSJim Jagielski 314*b1cdbd2cSJim JagielskiHandleErrors: 315*b1cdbd2cSJim Jagielski WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 316*b1cdbd2cSJim Jagielski Resume FinalExit 317*b1cdbd2cSJim JagielskiEnd Function 318*b1cdbd2cSJim Jagielski 319*b1cdbd2cSJim JagielskiSub Analyze_VBEReferences(docAnalysis As DocumentAnalysis, currDoc As Object) 320*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 321*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 322*b1cdbd2cSJim Jagielski currentFunctionName = "Analyze_VBEReferences" 323*b1cdbd2cSJim Jagielski 'References 324*b1cdbd2cSJim Jagielski Dim Ref As Reference 325*b1cdbd2cSJim Jagielski Dim fso As Scripting.FileSystemObject 326*b1cdbd2cSJim Jagielski Dim myVBProject As VBProject 327*b1cdbd2cSJim Jagielski Dim myVBComponent As VBComponent 328*b1cdbd2cSJim Jagielski 329*b1cdbd2cSJim Jagielski Set fso = New Scripting.FileSystemObject 330*b1cdbd2cSJim Jagielski 331*b1cdbd2cSJim Jagielski If CheckOnlyEmptyProject(docAnalysis, currDoc) Then 332*b1cdbd2cSJim Jagielski Exit Sub 333*b1cdbd2cSJim Jagielski End If 334*b1cdbd2cSJim Jagielski Set myVBProject = getAppSpecificVBProject(currDoc) 335*b1cdbd2cSJim Jagielski 336*b1cdbd2cSJim Jagielski For Each Ref In myVBProject.References 337*b1cdbd2cSJim Jagielski Analyze_VBEReferenceSingle docAnalysis, Ref, fso 338*b1cdbd2cSJim Jagielski Next Ref 339*b1cdbd2cSJim Jagielski 340*b1cdbd2cSJim JagielskiFinalExit: 341*b1cdbd2cSJim Jagielski Set myVBProject = Nothing 342*b1cdbd2cSJim Jagielski Set fso = Nothing 343*b1cdbd2cSJim Jagielski Exit Sub 344*b1cdbd2cSJim Jagielski 345*b1cdbd2cSJim JagielskiHandleErrors: 346*b1cdbd2cSJim Jagielski WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 347*b1cdbd2cSJim Jagielski Resume FinalExit 348*b1cdbd2cSJim JagielskiEnd Sub 349*b1cdbd2cSJim Jagielski 350*b1cdbd2cSJim JagielskiSub Analyze_VBEReferenceSingle(docAnalysis As DocumentAnalysis, Ref As Reference, fso As Scripting.FileSystemObject) 351*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 352*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 353*b1cdbd2cSJim Jagielski currentFunctionName = "Analyze_VBEReferenceSingle" 354*b1cdbd2cSJim Jagielski 'References 355*b1cdbd2cSJim Jagielski Dim myIssue As IssueInfo 356*b1cdbd2cSJim Jagielski Dim bBadRef As Boolean 357*b1cdbd2cSJim Jagielski 358*b1cdbd2cSJim Jagielski Set myIssue = New IssueInfo 359*b1cdbd2cSJim Jagielski With myIssue 360*b1cdbd2cSJim Jagielski .IssueID = CID_INFORMATION_REFS 361*b1cdbd2cSJim Jagielski .IssueType = RID_STR_COMMON_ISSUE_INFORMATION 362*b1cdbd2cSJim Jagielski .SubType = RID_STR_COMMON_SUBISSUE_REFERENCES 363*b1cdbd2cSJim Jagielski .Location = .CLocationDocument 364*b1cdbd2cSJim Jagielski 365*b1cdbd2cSJim Jagielski .IssueTypeXML = CSTR_ISSUE_INFORMATION 366*b1cdbd2cSJim Jagielski .SubTypeXML = CSTR_SUBISSUE_REFERENCES 367*b1cdbd2cSJim Jagielski .locationXML = .CXMLLocationDocument 368*b1cdbd2cSJim Jagielski 369*b1cdbd2cSJim Jagielski If Ref.GUID = "" Then 370*b1cdbd2cSJim Jagielski bBadRef = True 371*b1cdbd2cSJim Jagielski Else 372*b1cdbd2cSJim Jagielski bBadRef = False 373*b1cdbd2cSJim Jagielski End If 374*b1cdbd2cSJim Jagielski If Not bBadRef Then 375*b1cdbd2cSJim Jagielski .SubLocation = LCase(fso.GetFileName(Ref.FullPath)) 376*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME 377*b1cdbd2cSJim Jagielski .Values.Add Ref.name, RID_STR_COMMON_ATTRIBUTE_NAME 378*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_DESCRIPTION 379*b1cdbd2cSJim Jagielski .Values.Add Ref.Description, RID_STR_COMMON_ATTRIBUTE_DESCRIPTION 380*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_FILE 381*b1cdbd2cSJim Jagielski .Values.Add LCase(fso.GetFileName(Ref.FullPath)), RID_STR_COMMON_ATTRIBUTE_FILE 382*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_PATH 383*b1cdbd2cSJim Jagielski .Values.Add LCase(Ref.FullPath), RID_STR_COMMON_ATTRIBUTE_PATH 384*b1cdbd2cSJim Jagielski Else 385*b1cdbd2cSJim Jagielski .SubLocation = RID_STR_COMMON_NA 386*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME 387*b1cdbd2cSJim Jagielski .Values.Add RID_STR_COMMON_ATTRIBUTE_MISSING, RID_STR_COMMON_ATTRIBUTE_NAME 388*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_DESCRIPTION 389*b1cdbd2cSJim Jagielski .Values.Add RID_STR_COMMON_ATTRIBUTE_CHECK_DOCUMENT_REFERENCES, RID_STR_COMMON_ATTRIBUTE_DESCRIPTION 390*b1cdbd2cSJim Jagielski End If 391*b1cdbd2cSJim Jagielski 392*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_MAJOR 393*b1cdbd2cSJim Jagielski .Values.Add IIf(Not bBadRef, Ref.Major, ""), RID_STR_COMMON_ATTRIBUTE_MAJOR 394*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_MINOR 395*b1cdbd2cSJim Jagielski .Values.Add IIf(Not bBadRef, Ref.Minor, ""), RID_STR_COMMON_ATTRIBUTE_MINOR 396*b1cdbd2cSJim Jagielski 397*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_TYPE 398*b1cdbd2cSJim Jagielski .Values.Add IIf(Ref.Type = vbext_rk_Project, RID_STR_COMMON_ATTRIBUTE_PROJECT, RID_STR_COMMON_ATTRIBUTE_TYPELIB), RID_STR_COMMON_ATTRIBUTE_TYPE 399*b1cdbd2cSJim Jagielski 400*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_BUILTIN 401*b1cdbd2cSJim Jagielski .Values.Add IIf(Ref.BuiltIn, RID_STR_COMMON_ATTRIBUTE_BUILTIN, RID_STR_COMMON_ATTRIBUTE_CUSTOM), RID_STR_COMMON_ATTRIBUTE_BUILTIN 402*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_ISBROKEN 403*b1cdbd2cSJim Jagielski .Values.Add IIf(bBadRef, RID_STR_COMMON_ATTRIBUTE_BROKEN, RID_STR_COMMON_ATTRIBUTE_INTACT), RID_STR_COMMON_ATTRIBUTE_ISBROKEN 404*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_GUID 405*b1cdbd2cSJim Jagielski .Values.Add IIf(Ref.Type = vbext_rk_TypeLib, Ref.GUID, ""), RID_STR_COMMON_ATTRIBUTE_GUID 406*b1cdbd2cSJim Jagielski End With 407*b1cdbd2cSJim Jagielski 408*b1cdbd2cSJim Jagielski docAnalysis.References.Add myIssue 409*b1cdbd2cSJim Jagielski 410*b1cdbd2cSJim JagielskiFinalExit: 411*b1cdbd2cSJim Jagielski Set myIssue = Nothing 412*b1cdbd2cSJim Jagielski Exit Sub 413*b1cdbd2cSJim Jagielski 414*b1cdbd2cSJim JagielskiHandleErrors: 415*b1cdbd2cSJim Jagielski WriteDebugLevelTwo currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 416*b1cdbd2cSJim Jagielski Resume FinalExit 417*b1cdbd2cSJim JagielskiEnd Sub 418*b1cdbd2cSJim Jagielski 419*b1cdbd2cSJim JagielskiSub Analyze_MacrosForPortabilityIssues(docAnalysis As DocumentAnalysis, myProject As VBProject, myComponent As VBComponent) 420*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 421*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 422*b1cdbd2cSJim Jagielski currentFunctionName = "Analyze_MacrosForPortabilityIssues" 423*b1cdbd2cSJim Jagielski Dim myIssue As IssueInfo 424*b1cdbd2cSJim Jagielski Dim count As Long 425*b1cdbd2cSJim Jagielski 426*b1cdbd2cSJim Jagielski ' Code Modules 427*b1cdbd2cSJim Jagielski Dim strFind As String 428*b1cdbd2cSJim Jagielski strFind = VBFindLines(docAnalysis, myComponent.CodeModule, "CreateObject", count, bWholeWord:=True) & _ 429*b1cdbd2cSJim Jagielski VBFindLines(docAnalysis, myComponent.CodeModule, "GetObject", count, bWholeWord:=True) & _ 430*b1cdbd2cSJim Jagielski VBFindLines(docAnalysis, myComponent.CodeModule, "ADODB.", count, True, True) & _ 431*b1cdbd2cSJim Jagielski VBFindLines(docAnalysis, myComponent.CodeModule, "Word.", count, True, True) & _ 432*b1cdbd2cSJim Jagielski VBFindLines(docAnalysis, myComponent.CodeModule, "Excel.", count, True, True) & _ 433*b1cdbd2cSJim Jagielski VBFindLines(docAnalysis, myComponent.CodeModule, "PowerPoint.", count, True, True) & _ 434*b1cdbd2cSJim Jagielski VBFindLines(docAnalysis, myComponent.CodeModule, "Access.", count, True, True) & _ 435*b1cdbd2cSJim Jagielski VBFindLines(docAnalysis, myComponent.CodeModule, "Declare Function ", count, False) & _ 436*b1cdbd2cSJim Jagielski VBFindLines(docAnalysis, myComponent.CodeModule, "Declare Sub ", count, False) 437*b1cdbd2cSJim Jagielski 438*b1cdbd2cSJim Jagielski 439*b1cdbd2cSJim Jagielski If (strFind <> "") And (myComponent.Type <> vbext_ct_Document) Then 440*b1cdbd2cSJim Jagielski Set myIssue = New IssueInfo 441*b1cdbd2cSJim Jagielski With myIssue 442*b1cdbd2cSJim Jagielski .IssueID = CID_PORTABILITY 443*b1cdbd2cSJim Jagielski .IssueType = RID_STR_COMMON_ISSUE_PORTABILITY 444*b1cdbd2cSJim Jagielski .SubType = RID_STR_COMMON_SUBISSUE_EXTERNAL_REFERENCES_IN_MACROS 445*b1cdbd2cSJim Jagielski .Location = .CLocationDocument 446*b1cdbd2cSJim Jagielski 447*b1cdbd2cSJim Jagielski .IssueTypeXML = CSTR_ISSUE_PORTABILITY 448*b1cdbd2cSJim Jagielski .SubTypeXML = CSTR_SUBISSUE_EXTERNAL_REFERENCES_IN_MACRO 449*b1cdbd2cSJim Jagielski .locationXML = .CXMLLocationDocument 450*b1cdbd2cSJim Jagielski 451*b1cdbd2cSJim Jagielski .SubLocation = VBComponentType(myComponent) 452*b1cdbd2cSJim Jagielski 453*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_PROJECT 454*b1cdbd2cSJim Jagielski .Values.Add myProject.name 455*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_COMPONENT 456*b1cdbd2cSJim Jagielski .Values.Add myComponent.name 457*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NON_PORTABLE_EXTERNAL_REFERENCES 458*b1cdbd2cSJim Jagielski .Values.Add RID_STR_COMMON_ATTRIBUTE_INCLUDING & vbLf & Left(strFind, Len(strFind) - 1) 459*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NON_PORTABLE_EXTERNAL_REFERENCES_COUNT 460*b1cdbd2cSJim Jagielski .Values.Add count, RID_STR_COMMON_ATTRIBUTE_NON_PORTABLE_EXTERNAL_REFERENCES_COUNT 461*b1cdbd2cSJim Jagielski End With 462*b1cdbd2cSJim Jagielski docAnalysis.IssuesCountArray(CID_PORTABILITY) = _ 463*b1cdbd2cSJim Jagielski docAnalysis.IssuesCountArray(CID_PORTABILITY) + 1 464*b1cdbd2cSJim Jagielski docAnalysis.Issues.Add myIssue 465*b1cdbd2cSJim Jagielski docAnalysis.MacroNumExternalRefs = count + docAnalysis.MacroNumExternalRefs 466*b1cdbd2cSJim Jagielski docAnalysis.MacroIssuesCount = docAnalysis.MacroIssuesCount + 1 467*b1cdbd2cSJim Jagielski End If 468*b1cdbd2cSJim Jagielski 469*b1cdbd2cSJim JagielskiFinalExit: 470*b1cdbd2cSJim Jagielski Set myIssue = Nothing 471*b1cdbd2cSJim Jagielski Exit Sub 472*b1cdbd2cSJim Jagielski 473*b1cdbd2cSJim Jagielski 474*b1cdbd2cSJim JagielskiHandleErrors: 475*b1cdbd2cSJim Jagielski WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 476*b1cdbd2cSJim JagielskiResume FinalExit 477*b1cdbd2cSJim JagielskiEnd Sub 478*b1cdbd2cSJim Jagielski 479*b1cdbd2cSJim Jagielski'Find Lines in code module containing strFind and return list of them 480*b1cdbd2cSJim JagielskiFunction VBFindLines(docAnalysis As DocumentAnalysis, vbcm As CodeModule, strFind As String, _ 481*b1cdbd2cSJim Jagielski count As Long, _ 482*b1cdbd2cSJim Jagielski Optional bInProcedure As Boolean = True, _ 483*b1cdbd2cSJim Jagielski Optional bUsingNew As Boolean = False, _ 484*b1cdbd2cSJim Jagielski Optional bWholeWord As Boolean = False, _ 485*b1cdbd2cSJim Jagielski Optional bMatchCase As Boolean = False) As String 486*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 487*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 488*b1cdbd2cSJim Jagielski currentFunctionName = "VBFindLines" 489*b1cdbd2cSJim Jagielski Dim lngStartLine As Long 490*b1cdbd2cSJim Jagielski Dim lngStartCol As Long 491*b1cdbd2cSJim Jagielski Dim lngEndLine As Long 492*b1cdbd2cSJim Jagielski Dim lngEndCol As Long 493*b1cdbd2cSJim Jagielski Dim strLine As String 494*b1cdbd2cSJim Jagielski lngStartLine = 1 495*b1cdbd2cSJim Jagielski lngStartCol = 1 496*b1cdbd2cSJim Jagielski lngEndLine = vbcm.CountOfLines 497*b1cdbd2cSJim Jagielski Dim tmpString As String 498*b1cdbd2cSJim Jagielski If (vbcm.CountOfLines = 0) Then 499*b1cdbd2cSJim Jagielski Exit Function 500*b1cdbd2cSJim Jagielski End If 501*b1cdbd2cSJim Jagielski tmpString = vbcm.Lines(vbcm.CountOfLines, 1) 502*b1cdbd2cSJim Jagielski lngEndCol = Len(vbcm.Lines(vbcm.CountOfLines, 1)) 503*b1cdbd2cSJim Jagielski Dim lngType As Long 504*b1cdbd2cSJim Jagielski Dim strProc As String 505*b1cdbd2cSJim Jagielski Dim retStr As String 506*b1cdbd2cSJim Jagielski 507*b1cdbd2cSJim Jagielski ' Search 508*b1cdbd2cSJim Jagielski Do While vbcm.Find(strFind, lngStartLine, _ 509*b1cdbd2cSJim Jagielski lngStartCol, lngEndLine, lngEndCol, bWholeWord, bMatchCase) 510*b1cdbd2cSJim Jagielski 511*b1cdbd2cSJim Jagielski 'Ignore any lines using this func 512*b1cdbd2cSJim Jagielski If InStr(1, vbcm.Lines(lngStartLine, 1), "VBFindLines") <> 0 Then 513*b1cdbd2cSJim Jagielski GoTo CONTINUE_LOOP 514*b1cdbd2cSJim Jagielski End If 515*b1cdbd2cSJim Jagielski 516*b1cdbd2cSJim Jagielski If bInProcedure Then 517*b1cdbd2cSJim Jagielski If bUsingNew Then 518*b1cdbd2cSJim Jagielski If InStr(1, vbcm.Lines(lngStartLine, 1), "New") <> 0 Then 519*b1cdbd2cSJim Jagielski strProc = vbcm.ProcOfLine(lngStartLine, lngType) 520*b1cdbd2cSJim Jagielski Else 521*b1cdbd2cSJim Jagielski strProc = "" 522*b1cdbd2cSJim Jagielski End If 523*b1cdbd2cSJim Jagielski Else 524*b1cdbd2cSJim Jagielski strProc = vbcm.ProcOfLine(lngStartLine, lngType) 525*b1cdbd2cSJim Jagielski End If 526*b1cdbd2cSJim Jagielski If strProc = "" Then GoTo CONTINUE_LOOP 527*b1cdbd2cSJim Jagielski 528*b1cdbd2cSJim Jagielski VBFindLines = VBFindLines & "[" & strProc & " ( ) - " & lngStartLine & " ]" & _ 529*b1cdbd2cSJim Jagielski vbLf & vbcm.Lines(lngStartLine, 1) & vbLf 530*b1cdbd2cSJim Jagielski Else 531*b1cdbd2cSJim Jagielski strProc = vbcm.Lines(lngStartLine, 1) 532*b1cdbd2cSJim Jagielski If strProc = "" Then GoTo CONTINUE_LOOP 533*b1cdbd2cSJim Jagielski 534*b1cdbd2cSJim Jagielski 'Can be External refs, Const, Type or variable declarations 535*b1cdbd2cSJim Jagielski If InStr(1, vbcm.Lines(lngStartLine, 1), "Declare Function") <> 0 Then 536*b1cdbd2cSJim Jagielski VBFindLines = VBFindLines & "[" & RID_STR_COMMON_DEC_TO_EXTERNAL_LIBRARY & " - " & lngStartLine & " ]" & _ 537*b1cdbd2cSJim Jagielski vbLf & strProc & vbLf 538*b1cdbd2cSJim Jagielski Else 539*b1cdbd2cSJim Jagielski VBFindLines = VBFindLines & "[" & RID_STR_COMMON_VB_COMPONENT_MODULE & " " & strFind & _ 540*b1cdbd2cSJim Jagielski " - " & lngStartLine & " ]" & vbLf 541*b1cdbd2cSJim Jagielski End If 542*b1cdbd2cSJim Jagielski End If 543*b1cdbd2cSJim Jagielski count = count + 1 544*b1cdbd2cSJim Jagielski 545*b1cdbd2cSJim JagielskiCONTINUE_LOOP: 546*b1cdbd2cSJim Jagielski 'Reset Params to search for next hit 547*b1cdbd2cSJim Jagielski lngStartLine = lngEndLine + 1 548*b1cdbd2cSJim Jagielski lngStartCol = 1 549*b1cdbd2cSJim Jagielski lngEndLine = vbcm.CountOfLines 550*b1cdbd2cSJim Jagielski lngEndCol = Len(vbcm.Lines(vbcm.CountOfLines, 1)) 551*b1cdbd2cSJim Jagielski 552*b1cdbd2cSJim Jagielski If lngStartLine >= lngEndLine Then Exit Function 553*b1cdbd2cSJim Jagielski 554*b1cdbd2cSJim Jagielski Loop 'End - Do While vbcm.Find 555*b1cdbd2cSJim Jagielski VBFindLines = VBFindLines 556*b1cdbd2cSJim Jagielski Exit Function 557*b1cdbd2cSJim Jagielski 558*b1cdbd2cSJim JagielskiHandleErrors: 559*b1cdbd2cSJim Jagielski WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 560*b1cdbd2cSJim JagielskiEnd Function 561*b1cdbd2cSJim JagielskiFunction VBNumLines(docAnalysis As DocumentAnalysis, vbcm As CodeModule) As Long 562*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 563*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 564*b1cdbd2cSJim Jagielski currentFunctionName = "VBNumLines" 565*b1cdbd2cSJim Jagielski Dim cLines As Long 566*b1cdbd2cSJim Jagielski Dim lngType As Long 567*b1cdbd2cSJim Jagielski Dim strProc As String 568*b1cdbd2cSJim Jagielski 569*b1cdbd2cSJim Jagielski 'Issue: Just give line count in module to be in sync with Macro Analysis and Migration Wizard 570*b1cdbd2cSJim Jagielski VBNumLines = vbcm.CountOfLines 571*b1cdbd2cSJim Jagielski 572*b1cdbd2cSJim Jagielski 'For cLines = 1 To vbcm.CountOfLines 573*b1cdbd2cSJim Jagielski ' strProc = vbcm.ProcOfLine(cLines, lngType) 574*b1cdbd2cSJim Jagielski ' If strProc <> "" Then 575*b1cdbd2cSJim Jagielski ' VBNumLines = VBNumLines - _ 576*b1cdbd2cSJim Jagielski ' (vbcm.ProcBodyLine(strProc, lngType) - vbcm.ProcStartLine(strProc, lngType)) 577*b1cdbd2cSJim Jagielski ' cLines = cLines + vbcm.ProcCountLines(strProc, lngType) - 1 578*b1cdbd2cSJim Jagielski ' End If 579*b1cdbd2cSJim Jagielski 'Next 580*b1cdbd2cSJim Jagielski Exit Function 581*b1cdbd2cSJim Jagielski 582*b1cdbd2cSJim JagielskiHandleErrors: 583*b1cdbd2cSJim Jagielski WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 584*b1cdbd2cSJim JagielskiEnd Function 585*b1cdbd2cSJim JagielskiFunction VBNumFuncs(docAnalysis As DocumentAnalysis, vbcm As CodeModule) As Long 586*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 587*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 588*b1cdbd2cSJim Jagielski currentFunctionName = "VBNumFuncs" 589*b1cdbd2cSJim Jagielski Dim cLines As Long 590*b1cdbd2cSJim Jagielski Dim lngType As Long 591*b1cdbd2cSJim Jagielski Dim strProc As String 592*b1cdbd2cSJim Jagielski 593*b1cdbd2cSJim Jagielski For cLines = 1 To vbcm.CountOfLines 594*b1cdbd2cSJim Jagielski strProc = vbcm.ProcOfLine(cLines, lngType) 595*b1cdbd2cSJim Jagielski If strProc <> "" Then 596*b1cdbd2cSJim Jagielski VBNumFuncs = VBNumFuncs + 1 597*b1cdbd2cSJim Jagielski cLines = cLines + vbcm.ProcCountLines(strProc, lngType) - 1 598*b1cdbd2cSJim Jagielski End If 599*b1cdbd2cSJim Jagielski Next 600*b1cdbd2cSJim Jagielski Exit Function 601*b1cdbd2cSJim JagielskiHandleErrors: 602*b1cdbd2cSJim Jagielski WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 603*b1cdbd2cSJim JagielskiEnd Function 604*b1cdbd2cSJim Jagielski 605*b1cdbd2cSJim JagielskiFunction VBComponentType(vbc As VBComponent) As String 606*b1cdbd2cSJim Jagielski Select Case vbc.Type 607*b1cdbd2cSJim Jagielski Case vbext_ct_StdModule 608*b1cdbd2cSJim Jagielski VBComponentType = RID_STR_COMMON_VB_COMPONENT_STANDARD 609*b1cdbd2cSJim Jagielski Case vbext_ct_ClassModule 610*b1cdbd2cSJim Jagielski VBComponentType = RID_STR_COMMON_VB_COMPONENT_CLASS 611*b1cdbd2cSJim Jagielski Case vbext_ct_MSForm 612*b1cdbd2cSJim Jagielski VBComponentType = RID_STR_COMMON_VB_COMPONENT_USER_FORM 613*b1cdbd2cSJim Jagielski Case vbext_ct_Document 614*b1cdbd2cSJim Jagielski VBComponentType = RID_STR_COMMON_VB_COMPONENT_DOCUMENT 615*b1cdbd2cSJim Jagielski Case 11 'vbext_ct_ActiveX Designer 616*b1cdbd2cSJim Jagielski VBComponentType = RID_STR_COMMON_VB_COMPONENT_ACTIVEX_DESIGNER 617*b1cdbd2cSJim Jagielski Case Else 618*b1cdbd2cSJim Jagielski VBComponentType = RID_STR_COMMON_UNKNOWN 619*b1cdbd2cSJim Jagielski End Select 620*b1cdbd2cSJim JagielskiEnd Function 621*b1cdbd2cSJim Jagielski 622*b1cdbd2cSJim JagielskiFunction CheckEmptyProject(docAnalysis As DocumentAnalysis, myProject As VBProject, myComponent As VBComponent) As Boolean 623*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 624*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 625*b1cdbd2cSJim Jagielski currentFunctionName = "CheckEmptyProject" 626*b1cdbd2cSJim Jagielski Dim bEmptyProject As Boolean 627*b1cdbd2cSJim Jagielski 628*b1cdbd2cSJim Jagielski 'Bug: Can have empty project with different name from default, would be picked up 629*b1cdbd2cSJim Jagielski ' as not empty. 630*b1cdbd2cSJim Jagielski 'bEmptyProject = _ 631*b1cdbd2cSJim Jagielski ' (StrComp(myProject.name, CTOPLEVEL_PROJECT) = 0) And _ 632*b1cdbd2cSJim Jagielski ' (VBNumFuncs(docAnalysis, myComponent.CodeModule) = 0) And _ 633*b1cdbd2cSJim Jagielski ' (VBNumLines(docAnalysis, myComponent.CodeModule) < 3) 634*b1cdbd2cSJim Jagielski 635*b1cdbd2cSJim Jagielski ' Code Modules 636*b1cdbd2cSJim Jagielski Dim strFind As String 637*b1cdbd2cSJim Jagielski Dim count As Long 638*b1cdbd2cSJim Jagielski 'Check for: 639*b1cdbd2cSJim Jagielski 'Public Const myFoo .... 640*b1cdbd2cSJim Jagielski 'Public Declare Function .... 641*b1cdbd2cSJim Jagielski 'Public myVar As ... 642*b1cdbd2cSJim Jagielski strFind = VBFindLines(docAnalysis, myComponent.CodeModule, "Public", _ 643*b1cdbd2cSJim Jagielski count, bInProcedure:=False, bWholeWord:=True, bMatchCase:=True) 644*b1cdbd2cSJim Jagielski 645*b1cdbd2cSJim Jagielski bEmptyProject = _ 646*b1cdbd2cSJim Jagielski (VBNumFuncs(docAnalysis, myComponent.CodeModule) = 0) And _ 647*b1cdbd2cSJim Jagielski (VBNumLines(docAnalysis, myComponent.CodeModule) < 3) And _ 648*b1cdbd2cSJim Jagielski (strFind = "") 649*b1cdbd2cSJim Jagielski 650*b1cdbd2cSJim Jagielski CheckEmptyProject = IIf(bEmptyProject, True, False) 651*b1cdbd2cSJim Jagielski Exit Function 652*b1cdbd2cSJim Jagielski 653*b1cdbd2cSJim Jagielski 654*b1cdbd2cSJim JagielskiHandleErrors: 655*b1cdbd2cSJim Jagielski WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 656*b1cdbd2cSJim JagielskiEnd Function 657*b1cdbd2cSJim Jagielski 658*b1cdbd2cSJim JagielskiFunction getCustomDocPropTypeAsString(propType As MsoDocProperties) 659*b1cdbd2cSJim Jagielski Dim Str As String 660*b1cdbd2cSJim Jagielski 661*b1cdbd2cSJim Jagielski Select Case propType 662*b1cdbd2cSJim Jagielski Case msoPropertyTypeBoolean 663*b1cdbd2cSJim Jagielski Str = RID_STR_COMMON_YES_OR_NO 664*b1cdbd2cSJim Jagielski Case msoPropertyTypeDate 665*b1cdbd2cSJim Jagielski Str = RID_STR_COMMON_DATE 666*b1cdbd2cSJim Jagielski Case msoPropertyTypeFloat 667*b1cdbd2cSJim Jagielski Str = RID_STR_COMMON_NUMBER 668*b1cdbd2cSJim Jagielski Case msoPropertyTypeNumber 669*b1cdbd2cSJim Jagielski Str = RID_STR_COMMON_NUMBER 670*b1cdbd2cSJim Jagielski Case msoPropertyTypeString 671*b1cdbd2cSJim Jagielski Str = RID_STR_COMMON_TEXT 672*b1cdbd2cSJim Jagielski Case Else 673*b1cdbd2cSJim Jagielski Str = "Unknown" 674*b1cdbd2cSJim Jagielski End Select 675*b1cdbd2cSJim Jagielski 676*b1cdbd2cSJim Jagielski getCustomDocPropTypeAsString = Str 677*b1cdbd2cSJim JagielskiEnd Function 678*b1cdbd2cSJim Jagielski 679*b1cdbd2cSJim JagielskiSub HandleProtectedDocInvalidPassword(docAnalysis As DocumentAnalysis, strError As String, fso As FileSystemObject) 680*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 681*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 682*b1cdbd2cSJim Jagielski currentFunctionName = "HandleProtectedDocInvalidPassword" 683*b1cdbd2cSJim Jagielski Dim f As File 684*b1cdbd2cSJim Jagielski Set f = fso.GetFile(docAnalysis.name) 685*b1cdbd2cSJim Jagielski 686*b1cdbd2cSJim Jagielski docAnalysis.Application = RID_STR_COMMON_PASSWORD_SKIPDOC 687*b1cdbd2cSJim Jagielski 688*b1cdbd2cSJim Jagielski On Error Resume Next 689*b1cdbd2cSJim Jagielski docAnalysis.PageCount = 0 690*b1cdbd2cSJim Jagielski docAnalysis.Created = f.DateCreated 691*b1cdbd2cSJim Jagielski docAnalysis.Modified = f.DateLastModified 692*b1cdbd2cSJim Jagielski docAnalysis.Accessed = f.DateLastAccessed 693*b1cdbd2cSJim Jagielski docAnalysis.Printed = DateValue("01/01/1900") 694*b1cdbd2cSJim Jagielski docAnalysis.SavedBy = RID_STR_COMMON_NA 695*b1cdbd2cSJim Jagielski docAnalysis.Revision = 0 696*b1cdbd2cSJim Jagielski docAnalysis.Template = RID_STR_COMMON_NA 697*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 698*b1cdbd2cSJim Jagielski 699*b1cdbd2cSJim Jagielski Dim myIssue As IssueInfo 700*b1cdbd2cSJim Jagielski Set myIssue = New IssueInfo 701*b1cdbd2cSJim Jagielski 702*b1cdbd2cSJim Jagielski With myIssue 703*b1cdbd2cSJim Jagielski .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES 704*b1cdbd2cSJim Jagielski .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES 705*b1cdbd2cSJim Jagielski .SubType = RID_STR_COMMON_SUBISSUE_INVALID_PASSWORD_ENTERED 706*b1cdbd2cSJim Jagielski .Location = .CLocationDocument 707*b1cdbd2cSJim Jagielski 708*b1cdbd2cSJim Jagielski .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES 709*b1cdbd2cSJim Jagielski .SubTypeXML = CSTR_SUBISSUE_INVALID_PASSWORD_ENTERED 710*b1cdbd2cSJim Jagielski .locationXML = .CXMLLocationDocument 711*b1cdbd2cSJim Jagielski 712*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_PASSWORD 713*b1cdbd2cSJim Jagielski .Values.Add strError 714*b1cdbd2cSJim Jagielski 715*b1cdbd2cSJim Jagielski docAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ 716*b1cdbd2cSJim Jagielski docAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 717*b1cdbd2cSJim Jagielski End With 718*b1cdbd2cSJim Jagielski 719*b1cdbd2cSJim Jagielski docAnalysis.Issues.Add myIssue 720*b1cdbd2cSJim Jagielski 721*b1cdbd2cSJim JagielskiFinalExit: 722*b1cdbd2cSJim Jagielski Set myIssue = Nothing 723*b1cdbd2cSJim Jagielski Set f = Nothing 724*b1cdbd2cSJim Jagielski Exit Sub 725*b1cdbd2cSJim Jagielski 726*b1cdbd2cSJim JagielskiHandleErrors: 727*b1cdbd2cSJim Jagielski WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 728*b1cdbd2cSJim Jagielski Resume FinalExit 729*b1cdbd2cSJim JagielskiEnd Sub 730*b1cdbd2cSJim Jagielski 731*b1cdbd2cSJim JagielskiSub Analyze_OLEEmbeddedSingleShape(docAnalysis As DocumentAnalysis, aShape As Shape, mySubLocation As Variant) 732*b1cdbd2cSJim Jagielski 733*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 734*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 735*b1cdbd2cSJim Jagielski currentFunctionName = "Analyze_OLEEmbeddedSingleShape" 736*b1cdbd2cSJim Jagielski Dim myIssue As IssueInfo 737*b1cdbd2cSJim Jagielski Dim bOleObject As Boolean 738*b1cdbd2cSJim Jagielski Dim TypeAsString As String 739*b1cdbd2cSJim Jagielski Dim XMLTypeAsString As String 740*b1cdbd2cSJim Jagielski Dim objName As String 741*b1cdbd2cSJim Jagielski 742*b1cdbd2cSJim Jagielski bOleObject = (aShape.Type = msoEmbeddedOLEObject) Or _ 743*b1cdbd2cSJim Jagielski (aShape.Type = msoLinkedOLEObject) Or _ 744*b1cdbd2cSJim Jagielski (aShape.Type = msoOLEControlObject) 745*b1cdbd2cSJim Jagielski 746*b1cdbd2cSJim Jagielski If Not bOleObject Then Exit Sub 747*b1cdbd2cSJim Jagielski 748*b1cdbd2cSJim Jagielski aShape.Select 749*b1cdbd2cSJim Jagielski Select Case aShape.Type 750*b1cdbd2cSJim Jagielski Case msoEmbeddedOLEObject 751*b1cdbd2cSJim Jagielski TypeAsString = RID_STR_COMMON_OLE_EMBEDDED 752*b1cdbd2cSJim Jagielski XMLTypeAsString = CSTR_SUBISSUE_OLE_EMBEDDED 753*b1cdbd2cSJim Jagielski Case msoLinkedOLEObject 754*b1cdbd2cSJim Jagielski TypeAsString = RID_STR_COMMON_OLE_LINKED 755*b1cdbd2cSJim Jagielski XMLTypeAsString = CSTR_SUBISSUE_OLE_LINKED 756*b1cdbd2cSJim Jagielski Case msoOLEControlObject 757*b1cdbd2cSJim Jagielski TypeAsString = RID_STR_COMMON_OLE_CONTROL 758*b1cdbd2cSJim Jagielski XMLTypeAsString = CSTR_SUBISSUE_OLE_CONTROL 759*b1cdbd2cSJim Jagielski Case Else 760*b1cdbd2cSJim Jagielski TypeAsString = RID_STR_COMMON_OLE_UNKNOWN 761*b1cdbd2cSJim Jagielski XMLTypeAsString = CSTR_SUBISSUE_OLE_UNKNOWN 762*b1cdbd2cSJim Jagielski End Select 763*b1cdbd2cSJim Jagielski 764*b1cdbd2cSJim Jagielski Dim appStr As String 765*b1cdbd2cSJim Jagielski appStr = getAppSpecificApplicationName 766*b1cdbd2cSJim Jagielski 767*b1cdbd2cSJim Jagielski Set myIssue = New IssueInfo 768*b1cdbd2cSJim Jagielski With myIssue 769*b1cdbd2cSJim Jagielski .IssueID = CID_PORTABILITY 770*b1cdbd2cSJim Jagielski .IssueType = RID_STR_COMMON_ISSUE_PORTABILITY 771*b1cdbd2cSJim Jagielski .SubType = TypeAsString 772*b1cdbd2cSJim Jagielski .Location = .CLocationPage 773*b1cdbd2cSJim Jagielski .SubLocation = mySubLocation 774*b1cdbd2cSJim Jagielski 775*b1cdbd2cSJim Jagielski .IssueTypeXML = CSTR_ISSUE_PORTABILITY 776*b1cdbd2cSJim Jagielski .SubTypeXML = XMLTypeAsString 777*b1cdbd2cSJim Jagielski .locationXML = .CXMLLocationPage 778*b1cdbd2cSJim Jagielski 779*b1cdbd2cSJim Jagielski .Line = aShape.top 780*b1cdbd2cSJim Jagielski .column = aShape.Left 781*b1cdbd2cSJim Jagielski 782*b1cdbd2cSJim Jagielski If aShape.name <> "" Then 783*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME 784*b1cdbd2cSJim Jagielski .Values.Add aShape.name 785*b1cdbd2cSJim Jagielski End If 786*b1cdbd2cSJim Jagielski 787*b1cdbd2cSJim Jagielski If aShape.Type = msoEmbeddedOLEObject Or _ 788*b1cdbd2cSJim Jagielski aShape.Type = msoOLEControlObject Then 789*b1cdbd2cSJim Jagielski Dim objType As String 790*b1cdbd2cSJim Jagielski On Error Resume Next 791*b1cdbd2cSJim Jagielski 792*b1cdbd2cSJim Jagielski objType = getAppSpecificOLEClassType(aShape) 793*b1cdbd2cSJim Jagielski 794*b1cdbd2cSJim Jagielski If objType = "" Then GoTo FinalExit 795*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_OBJECT_TYPE 796*b1cdbd2cSJim Jagielski .Values.Add objType 797*b1cdbd2cSJim Jagielski 798*b1cdbd2cSJim Jagielski If aShape.Type = msoOLEControlObject Then 799*b1cdbd2cSJim Jagielski docAnalysis.MacroNumOLEControls = 1 + docAnalysis.MacroNumOLEControls 800*b1cdbd2cSJim Jagielski End If 801*b1cdbd2cSJim Jagielski 802*b1cdbd2cSJim Jagielski If appStr = CAPPNAME_POWERPOINT Then 803*b1cdbd2cSJim Jagielski '#114127: Too many open windows 804*b1cdbd2cSJim Jagielski 'Checking for OLEFormat.Object is Nothing or IsEmpty still causes problem 805*b1cdbd2cSJim Jagielski If objType <> "Equation.3" Then 806*b1cdbd2cSJim Jagielski objName = aShape.OLEFormat.Object.name 807*b1cdbd2cSJim Jagielski If Err.Number = 0 Then 808*b1cdbd2cSJim Jagielski If aShape.name <> objName Then 809*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_OBJECT_NAME 810*b1cdbd2cSJim Jagielski .Values.Add objName 811*b1cdbd2cSJim Jagielski End If 812*b1cdbd2cSJim Jagielski End If 813*b1cdbd2cSJim Jagielski End If 814*b1cdbd2cSJim Jagielski Else 815*b1cdbd2cSJim Jagielski If Not (aShape.OLEFormat.Object) Is Nothing Then 816*b1cdbd2cSJim Jagielski objName = aShape.OLEFormat.Object.name 817*b1cdbd2cSJim Jagielski If Err.Number = 0 Then 818*b1cdbd2cSJim Jagielski If aShape.name <> objName Then 819*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_OBJECT_NAME 820*b1cdbd2cSJim Jagielski .Values.Add objName 821*b1cdbd2cSJim Jagielski End If 822*b1cdbd2cSJim Jagielski End If 823*b1cdbd2cSJim Jagielski End If 824*b1cdbd2cSJim Jagielski End If 825*b1cdbd2cSJim Jagielski 826*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 827*b1cdbd2cSJim Jagielski End If 828*b1cdbd2cSJim Jagielski 829*b1cdbd2cSJim Jagielski If aShape.Type = msoLinkedOLEObject Then 830*b1cdbd2cSJim Jagielski If appStr <> CAPPNAME_WORD Then 831*b1cdbd2cSJim Jagielski On Error Resume Next 832*b1cdbd2cSJim Jagielski Dim path As String 833*b1cdbd2cSJim Jagielski path = aShape.OLEFormat.Object.SourceFullName 834*b1cdbd2cSJim Jagielski If Err.Number = 0 Then 835*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_SOURCE 836*b1cdbd2cSJim Jagielski .Values.Add path 837*b1cdbd2cSJim Jagielski End If 838*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 839*b1cdbd2cSJim Jagielski Else 840*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_SOURCE 841*b1cdbd2cSJim Jagielski .Values.Add aShape.LinkFormat.SourceFullName 842*b1cdbd2cSJim Jagielski End If 843*b1cdbd2cSJim Jagielski End If 844*b1cdbd2cSJim Jagielski 845*b1cdbd2cSJim Jagielski docAnalysis.IssuesCountArray(CID_PORTABILITY) = _ 846*b1cdbd2cSJim Jagielski docAnalysis.IssuesCountArray(CID_PORTABILITY) + 1 847*b1cdbd2cSJim Jagielski End With 848*b1cdbd2cSJim Jagielski docAnalysis.Issues.Add myIssue 849*b1cdbd2cSJim Jagielski 850*b1cdbd2cSJim JagielskiFinalExit: 851*b1cdbd2cSJim Jagielski Set myIssue = Nothing 852*b1cdbd2cSJim Jagielski Exit Sub 853*b1cdbd2cSJim Jagielski 854*b1cdbd2cSJim JagielskiHandleErrors: 855*b1cdbd2cSJim Jagielski WriteDebugLevelTwo currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 856*b1cdbd2cSJim Jagielski Resume FinalExit 857*b1cdbd2cSJim JagielskiEnd Sub 858*b1cdbd2cSJim Jagielski 859*b1cdbd2cSJim JagielskiSub Analyze_Lines(docAnalysis As DocumentAnalysis, myShape As Shape, mySubLocation As Variant) 860*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 861*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 862*b1cdbd2cSJim Jagielski currentFunctionName = "Analyze_Lines" 863*b1cdbd2cSJim Jagielski 864*b1cdbd2cSJim Jagielski If myShape.Line.Style = msoLineSingle Or _ 865*b1cdbd2cSJim Jagielski myShape.Line.Style = msoLineStyleMixed Then Exit Sub 866*b1cdbd2cSJim Jagielski 867*b1cdbd2cSJim Jagielski Dim myIssue As IssueInfo 868*b1cdbd2cSJim Jagielski Set myIssue = New IssueInfo 869*b1cdbd2cSJim Jagielski 870*b1cdbd2cSJim Jagielski With myIssue 871*b1cdbd2cSJim Jagielski .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES 872*b1cdbd2cSJim Jagielski .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES 873*b1cdbd2cSJim Jagielski .SubType = RID_RESXLS_COST_LineStyle 874*b1cdbd2cSJim Jagielski .Location = .CLocationPage 875*b1cdbd2cSJim Jagielski .SubLocation = mySubLocation 876*b1cdbd2cSJim Jagielski 877*b1cdbd2cSJim Jagielski .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES 878*b1cdbd2cSJim Jagielski .SubTypeXML = CSTR_SUBISSUE_LINE 879*b1cdbd2cSJim Jagielski .locationXML = .CXMLLocationPage 880*b1cdbd2cSJim Jagielski 881*b1cdbd2cSJim Jagielski .Line = myShape.top 882*b1cdbd2cSJim Jagielski .column = myShape.Left 883*b1cdbd2cSJim Jagielski 884*b1cdbd2cSJim Jagielski If myShape.name <> "" Then 885*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME 886*b1cdbd2cSJim Jagielski .Values.Add myShape.name 887*b1cdbd2cSJim Jagielski End If 888*b1cdbd2cSJim Jagielski 889*b1cdbd2cSJim Jagielski AddIssueDetailsNote myIssue, 0, RID_STR_COMMON_SUBISSUE_LINE_NOTE 890*b1cdbd2cSJim Jagielski 891*b1cdbd2cSJim Jagielski docAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ 892*b1cdbd2cSJim Jagielski docAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 893*b1cdbd2cSJim Jagielski End With 894*b1cdbd2cSJim Jagielski 895*b1cdbd2cSJim Jagielski docAnalysis.Issues.Add myIssue 896*b1cdbd2cSJim Jagielski 897*b1cdbd2cSJim JagielskiFinalExit: 898*b1cdbd2cSJim Jagielski Set myIssue = Nothing 899*b1cdbd2cSJim Jagielski Exit Sub 900*b1cdbd2cSJim Jagielski 901*b1cdbd2cSJim JagielskiHandleErrors: 902*b1cdbd2cSJim Jagielski WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 903*b1cdbd2cSJim Jagielski Resume FinalExit 904*b1cdbd2cSJim JagielskiEnd Sub 905*b1cdbd2cSJim Jagielski 906*b1cdbd2cSJim JagielskiSub Analyze_Transparency(docAnalysis As DocumentAnalysis, myShape As Shape, mySubLocation As Variant) 907*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 908*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 909*b1cdbd2cSJim Jagielski currentFunctionName = "Analyze_Transparency" 910*b1cdbd2cSJim Jagielski 911*b1cdbd2cSJim Jagielski If Not myShape.Type = msoPicture Then Exit Sub 912*b1cdbd2cSJim Jagielski 913*b1cdbd2cSJim Jagielski Dim bHasTransparentBkg 914*b1cdbd2cSJim Jagielski bHasTransparentBkg = False 915*b1cdbd2cSJim Jagielski 916*b1cdbd2cSJim Jagielski On Error Resume Next 917*b1cdbd2cSJim Jagielski If myShape.PictureFormat.TransparentBackground = msoTrue Then 918*b1cdbd2cSJim Jagielski If Error.Number = 0 Then 919*b1cdbd2cSJim Jagielski bHasTransparentBkg = True 920*b1cdbd2cSJim Jagielski End If 921*b1cdbd2cSJim Jagielski End If 922*b1cdbd2cSJim Jagielski 923*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 924*b1cdbd2cSJim Jagielski If Not bHasTransparentBkg Then Exit Sub 925*b1cdbd2cSJim Jagielski 926*b1cdbd2cSJim Jagielski Dim myIssue As IssueInfo 927*b1cdbd2cSJim Jagielski Set myIssue = New IssueInfo 928*b1cdbd2cSJim Jagielski 929*b1cdbd2cSJim Jagielski With myIssue 930*b1cdbd2cSJim Jagielski .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES 931*b1cdbd2cSJim Jagielski .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES 932*b1cdbd2cSJim Jagielski .SubType = RID_RESXLS_COST_Transparent 933*b1cdbd2cSJim Jagielski .Location = .CLocationSlide 934*b1cdbd2cSJim Jagielski .SubLocation = mySubLocation 935*b1cdbd2cSJim Jagielski 936*b1cdbd2cSJim Jagielski .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES 937*b1cdbd2cSJim Jagielski .SubTypeXML = CSTR_SUBISSUE_TRANSPARENCY 938*b1cdbd2cSJim Jagielski .locationXML = .CXMLLocationPage 939*b1cdbd2cSJim Jagielski 940*b1cdbd2cSJim Jagielski .Line = myShape.top 941*b1cdbd2cSJim Jagielski .column = myShape.Left 942*b1cdbd2cSJim Jagielski 943*b1cdbd2cSJim Jagielski If myShape.name <> "" Then 944*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME 945*b1cdbd2cSJim Jagielski .Values.Add myShape.name 946*b1cdbd2cSJim Jagielski End If 947*b1cdbd2cSJim Jagielski 948*b1cdbd2cSJim Jagielski AddIssueDetailsNote myIssue, 0, RID_STR_COMMON_SUBISSUE_TRANSPARENCY_NOTE 949*b1cdbd2cSJim Jagielski 950*b1cdbd2cSJim Jagielski docAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ 951*b1cdbd2cSJim Jagielski docAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 952*b1cdbd2cSJim Jagielski End With 953*b1cdbd2cSJim Jagielski 954*b1cdbd2cSJim Jagielski docAnalysis.Issues.Add myIssue 955*b1cdbd2cSJim Jagielski 956*b1cdbd2cSJim JagielskiFinalExit: 957*b1cdbd2cSJim Jagielski Set myIssue = Nothing 958*b1cdbd2cSJim Jagielski Exit Sub 959*b1cdbd2cSJim Jagielski 960*b1cdbd2cSJim JagielskiHandleErrors: 961*b1cdbd2cSJim Jagielski WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 962*b1cdbd2cSJim Jagielski Resume FinalExit 963*b1cdbd2cSJim JagielskiEnd Sub 964*b1cdbd2cSJim Jagielski 965*b1cdbd2cSJim JagielskiSub Analyze_Gradients(docAnalysis As DocumentAnalysis, myShape As Shape, mySubLocation As Variant) 966*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 967*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 968*b1cdbd2cSJim Jagielski currentFunctionName = "Analyze_Gradients" 969*b1cdbd2cSJim Jagielski 970*b1cdbd2cSJim Jagielski If myShape.Fill.Type <> msoFillGradient Then Exit Sub 971*b1cdbd2cSJim Jagielski 972*b1cdbd2cSJim Jagielski Dim bUsesPresetGradient, bUsesFromCorner, bUsesFromCenter 973*b1cdbd2cSJim Jagielski bUsesPresetGradient = False 974*b1cdbd2cSJim Jagielski bUsesFromCorner = False 975*b1cdbd2cSJim Jagielski bUsesFromCenter = False 976*b1cdbd2cSJim Jagielski 977*b1cdbd2cSJim Jagielski On Error Resume Next 978*b1cdbd2cSJim Jagielski If myShape.Fill.PresetGradientType <> msoPresetGradientMixed Then 979*b1cdbd2cSJim Jagielski If Error.Number = 0 Then 980*b1cdbd2cSJim Jagielski bUsesPresetGradient = True 981*b1cdbd2cSJim Jagielski End If 982*b1cdbd2cSJim Jagielski End If 983*b1cdbd2cSJim Jagielski If myShape.Fill.GradientStyle <> msoGradientFromCorner Then 984*b1cdbd2cSJim Jagielski If Error.Number = 0 Then 985*b1cdbd2cSJim Jagielski bUsesFromCorner = True 986*b1cdbd2cSJim Jagielski End If 987*b1cdbd2cSJim Jagielski End If 988*b1cdbd2cSJim Jagielski If myShape.Fill.GradientStyle <> msoGradientFromCenter Then 989*b1cdbd2cSJim Jagielski If Error.Number = 0 Then 990*b1cdbd2cSJim Jagielski bUsesFromCenter = True 991*b1cdbd2cSJim Jagielski End If 992*b1cdbd2cSJim Jagielski End If 993*b1cdbd2cSJim Jagielski 994*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 995*b1cdbd2cSJim Jagielski If Not bUsesPresetGradient And Not bUsesFromCorner _ 996*b1cdbd2cSJim Jagielski And Not bUsesFromCenter Then Exit Sub 997*b1cdbd2cSJim Jagielski 998*b1cdbd2cSJim Jagielski Dim myIssue As IssueInfo 999*b1cdbd2cSJim Jagielski Set myIssue = New IssueInfo 1000*b1cdbd2cSJim Jagielski 1001*b1cdbd2cSJim Jagielski With myIssue 1002*b1cdbd2cSJim Jagielski .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES 1003*b1cdbd2cSJim Jagielski .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES 1004*b1cdbd2cSJim Jagielski .SubType = RID_RESXLS_COST_GradientStyle 1005*b1cdbd2cSJim Jagielski .Location = .CLocationSlide 1006*b1cdbd2cSJim Jagielski .SubLocation = mySubLocation 1007*b1cdbd2cSJim Jagielski 1008*b1cdbd2cSJim Jagielski .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES 1009*b1cdbd2cSJim Jagielski .SubTypeXML = CSTR_SUBISSUE_GRADIENT 1010*b1cdbd2cSJim Jagielski .locationXML = .CXMLLocationSlide 1011*b1cdbd2cSJim Jagielski 1012*b1cdbd2cSJim Jagielski .Line = myShape.top 1013*b1cdbd2cSJim Jagielski .column = myShape.Left 1014*b1cdbd2cSJim Jagielski 1015*b1cdbd2cSJim Jagielski If myShape.name <> "" Then 1016*b1cdbd2cSJim Jagielski .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME 1017*b1cdbd2cSJim Jagielski .Values.Add myShape.name 1018*b1cdbd2cSJim Jagielski End If 1019*b1cdbd2cSJim Jagielski 1020*b1cdbd2cSJim Jagielski If bUsesPresetGradient Then 1021*b1cdbd2cSJim Jagielski AddIssueDetailsNote myIssue, 0, RID_STR_COMMON_SUBISSUE_GRADIENT_PRESET_NOTE 1022*b1cdbd2cSJim Jagielski ElseIf bUsesFromCorner Then 1023*b1cdbd2cSJim Jagielski AddIssueDetailsNote myIssue, 0, RID_STR_COMMON_SUBISSUE_GRADIENT_CORNER_NOTE 1024*b1cdbd2cSJim Jagielski Else 1025*b1cdbd2cSJim Jagielski AddIssueDetailsNote myIssue, 0, RID_STR_COMMON_SUBISSUE_GRADIENT_CENTER_NOTE 1026*b1cdbd2cSJim Jagielski End If 1027*b1cdbd2cSJim Jagielski 1028*b1cdbd2cSJim Jagielski docAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ 1029*b1cdbd2cSJim Jagielski docAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 1030*b1cdbd2cSJim Jagielski End With 1031*b1cdbd2cSJim Jagielski 1032*b1cdbd2cSJim Jagielski docAnalysis.Issues.Add myIssue 1033*b1cdbd2cSJim Jagielski 1034*b1cdbd2cSJim JagielskiFinalExit: 1035*b1cdbd2cSJim Jagielski Set myIssue = Nothing 1036*b1cdbd2cSJim Jagielski Exit Sub 1037*b1cdbd2cSJim Jagielski 1038*b1cdbd2cSJim JagielskiHandleErrors: 1039*b1cdbd2cSJim Jagielski WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1040*b1cdbd2cSJim Jagielski Resume FinalExit 1041*b1cdbd2cSJim JagielskiEnd Sub 1042*b1cdbd2cSJim Jagielski 1043*b1cdbd2cSJim JagielskiPrivate Function CreateFullPath(newPath As String, fso As FileSystemObject) 1044*b1cdbd2cSJim Jagielski 'We don't want to create 'c:\' 1045*b1cdbd2cSJim Jagielski If (Len(newPath) < 4) Then 1046*b1cdbd2cSJim Jagielski Exit Function 1047*b1cdbd2cSJim Jagielski End If 1048*b1cdbd2cSJim Jagielski 1049*b1cdbd2cSJim Jagielski 'Create parent folder first 1050*b1cdbd2cSJim Jagielski If (Not fso.FolderExists(fso.GetParentFolderName(newPath))) Then 1051*b1cdbd2cSJim Jagielski CreateFullPath fso.GetParentFolderName(newPath), fso 1052*b1cdbd2cSJim Jagielski End If 1053*b1cdbd2cSJim Jagielski 1054*b1cdbd2cSJim Jagielski If (Not fso.FolderExists(newPath)) Then 1055*b1cdbd2cSJim Jagielski fso.CreateFolder (newPath) 1056*b1cdbd2cSJim Jagielski End If 1057*b1cdbd2cSJim JagielskiEnd Function 1058*b1cdbd2cSJim Jagielski 1059*b1cdbd2cSJim JagielskiFunction GetPreparedFullPath(sourceDocPath As String, startDir As String, storeToDir As String, _ 1060*b1cdbd2cSJim Jagielski fso As FileSystemObject) As String 1061*b1cdbd2cSJim Jagielski On Error GoTo HandleErrors 1062*b1cdbd2cSJim Jagielski Dim currentFunctionName As String 1063*b1cdbd2cSJim Jagielski currentFunctionName = "GetPreparedFullPath" 1064*b1cdbd2cSJim Jagielski GetPreparedFullPath = "" 1065*b1cdbd2cSJim Jagielski 1066*b1cdbd2cSJim Jagielski Dim preparedPath As String 1067*b1cdbd2cSJim Jagielski 1068*b1cdbd2cSJim Jagielski preparedPath = Right(sourceDocPath, Len(sourceDocPath) - Len(startDir)) 1069*b1cdbd2cSJim Jagielski If Left(preparedPath, 1) = "\" Then 1070*b1cdbd2cSJim Jagielski preparedPath = Right(preparedPath, Len(preparedPath) - 1) 1071*b1cdbd2cSJim Jagielski End If 1072*b1cdbd2cSJim Jagielski 1073*b1cdbd2cSJim Jagielski 'Allow for root folder C:\ 1074*b1cdbd2cSJim Jagielski If Right(storeToDir, 1) <> "\" Then 1075*b1cdbd2cSJim Jagielski preparedPath = storeToDir & "\" & CSTR_COMMON_PREPARATION_FOLDER & "\" & preparedPath 1076*b1cdbd2cSJim Jagielski Else 1077*b1cdbd2cSJim Jagielski preparedPath = storeToDir & CSTR_COMMON_PREPARATION_FOLDER & "\" & preparedPath 1078*b1cdbd2cSJim Jagielski End If 1079*b1cdbd2cSJim Jagielski 1080*b1cdbd2cSJim Jagielski 'Debug: MsgBox "Preppath: " & preparedPath 1081*b1cdbd2cSJim Jagielski CreateFullPath fso.GetParentFolderName(preparedPath), fso 1082*b1cdbd2cSJim Jagielski 1083*b1cdbd2cSJim Jagielski 'Only set if folder to save to exists or has been created, otherwise return "" 1084*b1cdbd2cSJim Jagielski GetPreparedFullPath = preparedPath 1085*b1cdbd2cSJim Jagielski 1086*b1cdbd2cSJim JagielskiFinalExit: 1087*b1cdbd2cSJim Jagielski Exit Function 1088*b1cdbd2cSJim Jagielski 1089*b1cdbd2cSJim JagielskiHandleErrors: 1090*b1cdbd2cSJim Jagielski WriteDebugLevelTwo currentFunctionName & " : " & sourceDocPath & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1091*b1cdbd2cSJim Jagielski Resume FinalExit 1092*b1cdbd2cSJim JagielskiEnd Function 1093*b1cdbd2cSJim Jagielski 1094*b1cdbd2cSJim JagielskiFunction ClassifyDocOverallMacroClass(docAnalysis As DocumentAnalysis) As EnumDocOverallMacroClass 1095*b1cdbd2cSJim Jagielski ClassifyDocOverallMacroClass = enMacroNone 1096*b1cdbd2cSJim Jagielski 1097*b1cdbd2cSJim Jagielski If Not docAnalysis.HasMacros Then Exit Function 1098*b1cdbd2cSJim Jagielski 1099*b1cdbd2cSJim Jagielski If (docAnalysis.MacroTotalNumLines >= CMACRO_LINECOUNT_MEDIUM_LBOUND) Then 1100*b1cdbd2cSJim Jagielski If (docAnalysis.MacroNumExternalRefs > 0) Or _ 1101*b1cdbd2cSJim Jagielski (docAnalysis.MacroNumOLEControls > 0 Or docAnalysis.MacroNumFieldsUsingMacros > 0) Or _ 1102*b1cdbd2cSJim Jagielski docAnalysis.MacroNumUserForms > 0 Then 1103*b1cdbd2cSJim Jagielski ClassifyDocOverallMacroClass = enMacroComplex 1104*b1cdbd2cSJim Jagielski Else 1105*b1cdbd2cSJim Jagielski ClassifyDocOverallMacroClass = enMacroMedium 1106*b1cdbd2cSJim Jagielski End If 1107*b1cdbd2cSJim Jagielski Else 1108*b1cdbd2cSJim Jagielski ClassifyDocOverallMacroClass = enMacroSimple 1109*b1cdbd2cSJim Jagielski End If 1110*b1cdbd2cSJim Jagielski 1111*b1cdbd2cSJim JagielskiEnd Function 1112*b1cdbd2cSJim Jagielski 1113