Getting an OLEObject By Name

Started by OldSchool1948, May 13, 2020, 12:11:31 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

OldSchool1948

I'm using the following example code to get an OLEObject by name.  I keep getting error "Object name not found".  I'm a fairly experienced Visio/VBA developer.  This has me stumped.

Private Sub zzz()

    Dim vsoPage as Visio.Page
    Set vsoPage = ThisDocument.Pages("Patching")

    Dim oObject as Visio.OLEObject
    Set oObject = vsoPage.OLEObjects("cmdOpenPatchTool")

End sub


I cut & pasted the name from the command button so I know it's correct.  To workaround whatever is causing this problem, I wrote this function.  It works fine.  I just want to figure this out.

Private Function getOLEObjectOnPage( _
                           vsoPage as Visio.Page, _
                           strObjectName as String) as Object

    Dim vsoOLEObjects as Visio.OLEObjects
    Set vsoOLEObjects = vsoPage.OLEObjects

    Dim Obj as Object
    For Each Obj in vsoOLEObjects

        If Obj.Object.Name = strObjectName Then
            Set getOLEObjectOnPage = Obj
            Exit For
        End if

    Next Obj

End Function



Yacine

a very naive suggestion for debugging:
iterate over the oleobjects and debug.print their name
just to check the name does really exist
Yacine

Paul Herber

The shape may have different Name and NameU attributes. Look at the object's Name and NameU and see if they are different.

Electronic and Electrical engineering, business and software stencils for Visio -

https://www.paulherber.co.uk/

OldSchool1948

The names exist.  I use a macro that cycles though pages and exports to an Excel spreadsheet Visio Shape and OLE Object details.  For Objects, I export the Object.Name (unlike a Shape, an OLE Object does not have a .NameU property), ObjectType, Shape.ClassID), and many ShapeSheet details (e.g., PinX, PinY, LockDelete, LockText,).  I do the same thing for Shapes.

I built and maintain a fairly complex electronic system design document (eSDD).  It is used to capture the logical and physical design, technical specifications, deployment details, and build instructions for applications and systems, and all of their VMs that are maintained in Azure and on-prem.  Extracts from this tool are used to automate the commissioning and decommissioning of VMs.

When the UI or functionality changes, existing eSDDs (of which there are over 300) need to be patched.  In many cases, I use the exported file to drive "Patch Tools" macros used to create, rename, format, and delete shapes, and to migrate ShapeData. 

I'm trying to optimize patching so that I don't have to cycle though every OLEObject on a page to find the one I need.



Paul Herber

Here is a document containing an embedded OLE object with different .Name and .NameU
Electronic and Electrical engineering, business and software stencils for Visio -

https://www.paulherber.co.uk/

wapperdude

Have you tried removing the dbl quotes from around the "cmdOpenPatchTool"?
Visio 2019 Pro

OldSchool1948

Paul, the Visio file has a rectangular shape.  I didn't find an OLE Object (e.g., Textbox, Combobox, or CommandButton). 

Wapperdude, without the quotes, the compiler generates a "variable not found" error.

As I said, this has me stumped.

Paul Herber

The shape is an OLE object.
A TextBox, ComboBox etc are Controls, these can be inserted via the Developer ribbon, not the Insert ribbon.
Anyway, example attached with such a shape with different .Name and .NameU
Electronic and Electrical engineering, business and software stencils for Visio -

https://www.paulherber.co.uk/

OldSchool1948

Paul,  in my example, I use oObject as the top level object.  In the Locals window, oObject has Object, Shape, and ShapeObject tree limb items.

  • The Object limb has a Name property, but no NameU property
  • The Shape limb has a Name and NameU property, but they contain generic OLEObject names and not the object's defined name
  • The ShapeObject limb has Name property, but no NameU property.  In this case, however, the Name property contains the object's defined name

Having said that, I'm going to futz with this a bit more.  Ultimately, I want to parse through an Excel worksheet and substitute "cmdOpenPatchTool" with a variable so that I can apply updates using metadata.
    Dim oObject as Visio.OLEObject
    Set oObject = vsoPage.OLEObjects("cmdOpenPatchTool")

Regards,

Johnnie

wapperdude

Quote= vsoPage.OLEObjects("cmdOpenPatchTool")

Looking at the Visio object model, I cannot find anything that would support this syntax.  So, I also played around with a variety of possibilities.  Again, nothing that comes close to that exact syntax.  As you've shown, there are work-arounds.  Iterating thru the page is not such a bad idea...it will determine if desired object is even on the page.  Otherwise, you need some sort of error trapping.  Here's some code that I tried...there were additional iterations, none of which worked, so, this catches the basic concepts.

Sub whoAmI()
    Dim vShp As Visio.Shape
    Dim oObj As Visio.OLEObject
    Dim spObj1 As Visio.OLEObject
    Dim spObj2 As Visio.OLEObject
    Dim spObj3 As Visio.OLEObject
    Dim oObjs As Visio.OLEObjects
   
    Set oObjs = ActivePage.OLEObjects

       
    For Each vShp In ActivePage.Shapes
        Debug.Print vShp.Name
        Debug.Print vShp.NameU
    Next
    Debug.Print "**********"
    For Each oObj In ActivePage.OLEObjects
        Debug.Print TypeName(oObj.Object)
        Debug.Print oObj.Object.Name
        Set spObj1 = oObj
        Debug.Print "spObj1 =", spObj1.Object.Name
        Set spObj2 = ActivePage.OLEObjects(1)
        Debug.Print "spObj2 =", spObj2.Object.Name
'        Set spObj3 = ActivePage.OLEObjects("ComboBox1")
'        Set spObj3 = ActivePage.OLEObjects("{8BD21D30-EC42-11CE-9E0D-00AA006002F3}")
'        Debug.Print "spObj3 =", spObj3.Object.Name

    Next
    Debug.Print "**********"
    For intCounter = 1 To oObjs.Count
        Debug.Print oObjs(intCounter).ClassID
        Debug.Print oObjs(intCounter).ProgID
        Debug.Print oObjs(intCounter).Object.Name
'        Debug.Print Object("{8BD21D30-EC42-11CE-9E0D-00AA006002F3}")
    Next intCounter
End Sub


I don't think you need to go the literal OLE route to do what you want.  Just a guess on my part...not enough detail to justify the validity of the statement.  Just saying...
Visio 2019 Pro

OldSchool1948

wapperdude

This
Quote= vsoPage.OLEObjects("cmdOpenPatchTool")

Came from the OLEObjects.Item property information at https://docs.microsoft.com/en-us/office/vba/api/visio.oleobjects.item where is shows "expression.Item(NameOrIndex)."  I used the syntax with and without .Item.  I figured it meant I could use the name of the object.  Maybe so, but I can't get it to work that way.   

What started me down this rabbit hole was when I had to delete several textbox and combobox objects, and recreate others - using my patching tool.  I wanted to find objects using their name as opposed to cycling. Cycling is very fast, so it's no big deal. For data entry/data protection reasons, I have various objects on different layers.  So I only have to cycle through objects on a particular layer, which speeds things up a bit.

I do have a routine that checks to make sure an object doesn't exist before I create it.  I have other's that check to make sure a Layer, Page, Shape, etc.., exists before I try to use them.  I started leaning VBA, Visio VBA and Excel VBA about three years.  I learned through the school of hard knocks how important that was  :).

Thanks for your help, and to everyone else that chimed in.

wapperdude

#11
Updated the macro to grab various object/shape identifiers.   Also shows variety of syntax constructions that actually work.

Sub whoAmI()
    Dim oObj As Visio.OLEObject
    Dim myObj As Visio.OLEObject
    Dim visCmbBx As Visio.Shape
         
         
    For Each oObj In ActivePage.OLEObjects
        Debug.Print "<<<<<>>>>>"
       Set visCmbBx = oObj.Shape
        Debug.Print visCmbBx.Name
        Debug.Print visCmbBx.NameU

        Set myObj = ActivePage.OLEObjects(visCmbBx.Name)
        Debug.Print myObj.Object.Name

        Debug.Print "#############"

        With oObj.Object
            Debug.Print TypeName(.Object)
            Debug.Print .Name
            Debug.Print .ClassID
            Debug.Print .ProgID
        End With
        With oObj
            objName = TypeName(.Object)
            Select Case objName
                Case Is = "ComboBox"
                    Debug.Print "I am a combo box!"
                    With .Object.                     'edit box properties
                        .BackColor = RGB(200, 200, 255)
                        .Font.Name = "DomCasual BT"
                        .Font.Size = 12
                        .AutoSize = True
                    End With
            End Select
        End With
    Next
End Sub
Visio 2019 Pro

OldSchool1948

After doing a bit more research, I found my answer using CallByName. It allows me to directly get a ThisDocument ActiveX object by name without having to cycle through all objects on a page or all objects in the document to find a particular control.
Private Sub aaa()

    Dim vsoDocument As Visio.Document
    Set vsoDocument = ThisDocument
   
    Dim strObjectName As String
    strObjectName = "txtGPMEmail"
   
    '// Get a ThisDocument ActiveX control by name
    Dim Obj As Object
    Set Obj = getThisDocumentObject( _
                vsoDocument, _
                strObjectName)
               
    If Not Obj Is Nothing Then
   
        On Error GoTo exitHere
       
        '// Set Object properties
        CallByName Obj, "fontsize", VbLet, 12
        CallByName Obj, "fontname", VbLet, "Arial"
        CallByName Obj, "fontbold", VbLet, True
       
        Dim vsoShape As Visio.Shape
        Set vsoShape = Obj.Shape
       
        Debug.Print vsoShape.Cells("PinX").ResultStr("")
        Debug.Print vsoShape.Cells("PinY").ResultStr("")
        Debug.Print vsoShape.Cells("Width").ResultStr("")
        Debug.Print vsoShape.Cells("Height").ResultStr("")
   
        If vsoShape.LayerCount > 0 Then
            Debug.Print vsoShape.Layer(1).Name
        End If
       
    End If
   
exitHere:

    On Error GoTo 0
   
End Sub

Public Function getThisDocumentObject( _
                    vsoDocument As Visio.Document, _
                    strObjectName As String) As Object

On Error GoTo exitHere

    Set getThisDocumentObject = CallByName(vsoDocument, strObjectName, VbGet)
   
exitHere:

On Error GoTo 0

End Function


wapperdude

@OldSchool1948:  nice find regarding CallByName function.

Code has been updated to demonstrate searching by page, by document, using case statements to filter results, using CallByName function...both globally and object specific. 

Sub whoAmI()
'There are three major sections within this module:
'1:  Code that searches thru each page
'    This includes case statements to "filter" specific objects.  More "global" than
'    the CallByName function.
'    This code also shows OLE Object can have both a shape and an OLE identity.

'2:  Code that searches thru the document
'3:  Code that uses the CallByName function.  Credit to OldSchool1948 for discovery of this function
'
'The CallByName function is useful if you know the specific object in question
'The document search is helpful to find the specific object names, should you not know.
'The page search can be a limited search or can be a document-wide search

    Dim oObj As Visio.OLEObject
    Dim myObj As Visio.OLEObject
    Dim visCmbBx As Visio.Shape
         
' The following code line search each page withing the document:"
    For Each pg In ActiveDocument.Pages
        Debug.Print "=====     ", pg.Name, "     ====="
        For Each oObj In pg.OLEObjects
            Debug.Print "<<<<<  As Shape Object  >>>>>"
            Set visCmbBx = oObj.Shape
            Debug.Print visCmbBx.Name
            Debug.Print visCmbBx.NameU
   
            Set myObj = pg.OLEObjects(visCmbBx.Name)
            Debug.Print myObj.Object.Name, "Shape.NameU"
   
            Debug.Print "#######  As OLE Object  #######"
            With oObj.Object
                Debug.Print TypeName(.Object)
                Debug.Print .Name, "Object.Name"
                Debug.Print .ClassID
                Debug.Print .ProgID
            End With

'Filtering results using Case statements:
            With oObj
                objName = TypeName(.Object)
                Select Case objName                          'Only one case is shown.  Add more as needed
                    Case Is = "ComboBox"                    'This does only ALL combo boxes and ignores other OLE objects.
                        With .Object
                            .BackColor = RGB(255, 255, 0)
                            .Font.Name = "DomCasual BT"
                            .Font.Size = 12
                            .AutoSize = True
                        End With
                End Select
            End With
       
'Syntax, using CallByName function:
'
'        CallByName myObj.Object, "fontsize", VbLet, 24      'This works...ALL objects in doc / on page
'        CallByName oObj.Object, "FontSize", VbLet, 12         'This works...ALL objects in doc / on page
'        CallByName ComboBox1, "FontSize", VbLet, 12         'This works...a specific ComboBox
'        CallByName ComboBox2, "fontsize", VbLet, 18         'This works...a specific ComboBox
        Next
    Debug.Print ""
    Next

'Document search code:
    Debug.Print ""
    Debug.Print "///// Document Objects \\\\\"
    Debug.Print "Number of OLEObjects = ", ActiveDocument.OLEObjects.Count
   For Each oObj In ActiveDocument.OLEObjects
        With oObj.Object
            Debug.Print TypeName(.Object)
            Debug.Print .Name, "Object.Name"
            Debug.Print .ClassID
            Debug.Print .ProgID
        End With
    Next
End Sub

Visio 2019 Pro

OldSchool1948

This macro will go through a Visio file and write all shapes and objects to an Excel worksheet.  I use it to make maintenance of my application data driven for many things.  I hope folks will find it useful.  @wapperdude thanks for introducing me to TypeName.  I was using ClassID, this is much cleaner.

Private Sub exportShapeAndObjectInfo()

On Error GoTo errHandler

    Dim strFileName As String
    strFileName = "ShapeAndObjectInfo"
   
    Dim FilePath As String
    FilePath = Visio.ActiveDocument.Path & strFileName & C_FILE_EXT_XLSX
       
    Dim xlApp_Dest As Excel.Application
    Set xlApp_Dest = CreateObject("Excel.Application")
   
    xlApp_Dest.Visible = False
    xlApp_Dest.DisplayAlerts = False
   
    Dim xlWb_Dest As Excel.Workbook
    Set xlWb_Dest = xlApp_Dest.Workbooks.Add(Excel.xlWBATWorksheet)
   
    On Error Resume Next
    Err.Clear
   
    xlWb_Dest.SaveAs FileName:=FilePath
   
    If Err.Number = 1004 Then
   
        xlWb_Dest.Close
        Set xlApp_Dest = Nothing
       
        Dim strMsg
        strMsg = "One of these errors occured while trying to create the extract file:" & C_SPACE & vbCrLf & vbCrLf & _
                 "  (1) The filename contains invalid characters, or" & vbCrLf & _
                 "  (2) An Excel file is opended with the same name you are using." & vbCrLf & vbCrLf & _
                 "Please correct this error before trying again."
                 
        MsgBox strMsg
       
        GoTo exitHere
       
    End If
   
    On Error GoTo 0

    Dim xlWs_Dest As Excel.Worksheet
    Set xlWs_Dest = xlWb_Dest.Sheets("Sheet1")

    xlWs_Dest.Name = "ShapeInfo"
    xlWs_Dest.Activate
           
    With xlWs_Dest
                                       
        .Cells(1, 1) = "Page Name"
        .Cells(1, 2) = "ShapeName"
        .Cells(1, 3) = "ShapeText"
        .Cells(1, 4) = "PinX"
        .Cells(1, 5) = "PinY"
        .Cells(1, 6) = "Width"
        .Cells(1, 7) = "Height"
        .Cells(1, 8) = "LockDelete"
        .Cells(1, 9) = "LockTextEdit"
        .Cells(1, 10) = "LockWidth"
        .Cells(1, 11) = "LockHeight"
        .Cells(1, 12) = "LockMoveX"
        .Cells(1, 13) = "LockMoveY"
        .Cells(1, 14) = "LockSelect"
        .Cells(1, 15) = "Layer"
        .Cells(1, 16) = "ObjectType"
        .Cells(1, 17) = "ObjectClass"
       
        Dim c As Integer
        c = 2
       
        Dim vsoPage As Visio.Page
        For Each vsoPage In ThisDocument.Pages
                   
            Dim vsoShape As Visio.Shape
            For Each vsoShape In vsoPage.Shapes
           
                .Cells(c, 1) = vsoPage.Name
                .Cells(c, 2) = vsoShape.Name
                .Cells(c, 3) = vsoShape.Characters
                .Cells(c, 4) = vsoShape.Cells("PinX").ResultStr("")
                .Cells(c, 5) = vsoShape.Cells("PinY").ResultStr("")
                .Cells(c, 6) = vsoShape.Cells("Width").ResultStr("")
                .Cells(c, 7) = vsoShape.Cells("Height").ResultStr("")
                .Cells(c, 8) = vsoShape.Cells("LockDelete").ResultStr("")
                .Cells(c, 9) = vsoShape.Cells("LockTextEdit").ResultStr("")
                .Cells(c, 10) = vsoShape.Cells("LockWidth").ResultStr("")
                .Cells(c, 11) = vsoShape.Cells("LockHeight").ResultStr("")
                .Cells(c, 12) = vsoShape.Cells("LockMoveX").ResultStr("")
                .Cells(c, 13) = vsoShape.Cells("LockMoveY").ResultStr("")
                .Cells(c, 14) = vsoShape.Cells("LockSelect").ResultStr("")
               
                If vsoShape.LayerCount > 0 Then
                    .Cells(c, 15) = vsoShape.Layer(1).Name
                End If
               
                c = c + 1
               
            Next vsoShape
           
            Dim Obj As Object
            For Each Obj In vsoPage.OLEObjects
           
                Set vsoShape = Obj.Shape
               
                .Cells(c, 1) = vsoPage.Name
                .Cells(c, 2) = Obj.Object.Name
               
                Dim strObjText As String
                strObjText = ""

                Select Case TypeName(Obj.Object)
                    Case "Label"
                        strObjText = Obj.Object.Caption
                    Case "ComboBox"
                        strObjText = Obj.Object.Value
                    Case "CommandButton"
                        strObjText = Obj.Object.Caption
                    Case "TextBox"
                        strObjText = Obj.Object.Value
                End Select
               
                If strObjText <> "" Then
               
                    .Cells(c, 3) = strObjText
                    .Cells(c, 4) = vsoShape.Cells("PinX").ResultStr("")
                    .Cells(c, 5) = vsoShape.Cells("PinY").ResultStr("")
                    .Cells(c, 6) = vsoShape.Cells("Width").ResultStr("")
                    .Cells(c, 7) = vsoShape.Cells("Height").ResultStr("")
                    .Cells(c, 8) = vsoShape.Cells("LockDelete").ResultStr("")
                    .Cells(c, 9) = vsoShape.Cells("LockTextEdit").ResultStr("")
                    .Cells(c, 10) = vsoShape.Cells("LockWidth").ResultStr("")
                    .Cells(c, 11) = vsoShape.Cells("LockHeight").ResultStr("")
                    .Cells(c, 12) = vsoShape.Cells("LockMoveX").ResultStr("")
                    .Cells(c, 13) = vsoShape.Cells("LockMoveY").ResultStr("")
                    .Cells(c, 14) = vsoShape.Cells("LockSelect").ResultStr("")
                   
                    If vsoShape.LayerCount > 0 Then
                        .Cells(c, 15) = vsoShape.Layer(1).Name
                    End If
                   
                    .Cells(c, 16) = TypeName(Obj.Object)
                    .Cells(c, 17) = Obj.ClassID
                   
                    c = c + 1
               
                End If
               
            Next Obj
       
        Next vsoPage
           
    End With
                                               
exitHere:

'    If isObjectConnected(xlApp_Dest) Then xlApp_Dest.Visible = True
    If c > 2 Then
   
        '*************************************
        '// Sort Worksheet
        '*************************************
        Dim strMaxCol As String
        strMaxCol = "Q"
                   
        With xlWs_Dest
       
            Dim xlLastRow As Long
            xlLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
           
            Dim tgtRange As Excel.Range
            Set tgtRange = .Range( _
                                "A1:" & _
                                strMaxCol & _
                                xlLastRow)
                               
            tgtRange.AutoFilter Field:=1, _
                VisibleDropDown:=True
               
            .Activate
            .UsedRange.Columns.AutoFit
            .UsedRange.Rows.AutoFit
            .UsedRange.VerticalAlignment = xlTop
            .Range("A1:" & strMaxCol & "1").Interior.Color = RGB(189, 215, 238)
            .Range("A1:" & strMaxCol & "1").Font.Bold = True
            .Range("A2").Select
           
        End With

        xlApp_Dest.Visible = True
   
    End If
   
    On Error GoTo 0

    Exit Sub

errHandler:

'    If isObjectConnected(xlApp_Dest) Then
'        xlWb_Dest.Close savechanges:=False
'        xlApp_Dest.DisplayAlerts = True
'        xlApp_Dest.Quit
'        Set xlApp_Dest = Nothing
'    End If
'
'    Call showProgramError

    Resume exitHere

End Sub