A recent newsgroup question asked if it is possible to display the master name and the stencil that a shape originally came from.   Following on from my last post ( Re-opening Default Stencils ), I realised that this is possible  Here’s how (once you have created a reference to the Microsoft Scripting Runtime):

Public Sub DisplayOriginalMaster()

    If Visio.ActiveWindow.Selection.Count = 0 Then
        Exit Sub
    End If
Dim shp As Visio.Shape
    Set shp = Visio.ActiveWindow.Selection.PrimaryItem
    If shp.Master Is Nothing Then
        MsgBox "This shape has no master", vbExclamation
        Exit Sub
    End If

Dim mst As Visio.Master
    Set mst = shp.Master
Dim stenName As String
    stenName = getStencilName(mst.UniqueID)
    If Len(stenName) = 0 Then
        MsgBox "Sorry, I can't find the stencil this master (" & mst.Name & ") is from", vbExclamation
    Else
        MsgBox "This shape is the master : " & mst.Name & vbCrLf & "is from the stencil : " & stenName, vbExclamation
    End If

End Sub

Private Function getStencilName(ByVal mstID As String) As String

Dim srcDoc As Visio.Document
    Set srcDoc = Visio.ActiveDocument
Dim tmplt As String
    tmplt = srcDoc.Template
    If Len(tmplt) = 0 Then
        Exit Function
    End If

Dim fs As FileSystemObject
    Set fs = New FileSystemObject
    If fs.FileExists(tmplt) = False Then
        Exit Function
    End If
Dim winSrc As Visio.Window
Dim stenDoc As Visio.Document
Dim aryStens() As String
Dim win As Visio.Window
Dim arySrcStens() As String
    For Each win In Visio.Windows
        If win.Document Is srcDoc Then
            Set winSrc = win
            winSrc.DockedStencils arySrcStens
            Exit For
        End If
    Next

Dim sten As String
Dim stenName As String
Dim i As Integer
    For i = 0 To UBound(arySrcStens)
        stenName = stenContains(arySrcStens(i), mstID)
        If Len(stenName) > 0 Then
            getStencilName = stenName
            Exit Function
        End If
    Next
Dim doc As Visio.Document
    Set doc = Visio.Application.Documents.OpenEx(tmplt, Visio.visOpenCopy + Visio.visOpenHidden + Visio.visOpenDontList)

    For Each win In Visio.Windows
        If win.Document Is doc Then
            win.DockedStencils aryStens
        End If
    Next
    For i = 0 To UBound(aryStens)
        stenName = stenContains(aryStens(i), mstID)
        If Len(stenName) > 0 Then
            Exit For
        End If
    Next
    'Close the template document
    doc.Close

    getStencilName = stenName
End Function

Private Function stenContains(ByVal sten As String, ByVal mstID As String) As String
Dim doc As Visio.Document
Dim mst As Visio.Master
    For Each doc In Visio.Application.Documents
        If doc.FullName = sten Then
            For Each mst In doc.Masters
                If mst.UniqueID = mstID Then
                    stenContains = doc.Title
                    Exit Function
                End If
            Next
        End If
    Next
    stenContains = ""
End Function