Sub Test2()
Dim oSelectSet As SelectSet
    Set oSelectSet = ThisApplication.ActiveDocument.SelectSet

    Dim oGreenHighlight As HighlightSet
    Set oGreenHighlight = ThisApplication.ActiveDocument.CreateHighlightSet()
    oGreenHighlight.Color = ThisApplication.TransientObjects.CreateColor(0, 255, 0)

    Dim oSelect
    Set oSelect = oSelectSet.Item(1)

    'If selection is Face'
    If (oSelect.Type = kFaceObject) And (oSelectSet.Count = 1) Then
        Dim oBody As SurfaceBody
        Set oBody = oSelect.SurfaceBody()

        For I = 1 To oBody.Faces.Count Step 1
            If (oSelect.InternalName = oBody.Faces.Item(I).InternalName) Then
                oGreenHighlight.AddItem (oSelect)
                MsgBox ("Index of Face is " & CInt(I))
                Set oGreenHighlight = Nothing
            End If
        Next
    End If
End Sub