How to import a thumbnail from GxObject

The Import Thumbnail from GxObject sample provides the ability to use a different Thumbnail in place of the image ArcCatalog creates using the Preview Tab and "Create Thumbnail" button. The new images takes the place of the image generated in the Preview tab.

As opposed to most items that store Thumbnails in their metadata, Map Documents store Thumbnails in their .mxd file. Because of that, the "Create Thumbnail" button is not available for Map Documents. This sample provides a work around for creating Thumbnail Images for Map Documents (mxd) by copying the Thumbnail image from the map document into the metadata.

This macro doesn't verify that the selected object supports metadata, whether it already has metadata, or whether the metadata is writable.

How to use

Paste this macro into VBA.
Select an object in ArcCatalog that has metadata.
Run the macro.

[VBA]


        Sub importThumbFromObj()
    
    Dim pGxApp As IGxApplication
    Dim pGxSelObj As IGxObject
    Set pGxApp = Application
    Set pGxSelObj = pGxApp.SelectedObject
    If TypeOf pGxSelObj Is IMetadata Then
        
        Dim pGxMDE As IMetadataEdit
        Set pGxMDE = pGxSelObj
        If Not pGxMDE.CanEditMetadata Then Exit Sub
        
        Dim pGxD As IGxDialog
        Set pGxD = New GxDialog
        pGxD.Title = "Import Thumbnail"
        pGxD.ButtonCaption = "Open"
        pGxD.StartingLocation = Left(pGxSelObj.FullName, InStr(pGxSelObj.FullName, pGxSelObj.BaseName) - 1)
        
        Dim bReturn As Boolean
        Dim pGxObjEn As IEnumGxObject
        Dim pGxObj As IGxObject
        bReturn = pGxD.DoModalOpen(0, pGxObjEn)
        If Not bReturn = False Then
            Set pGxObj = pGxObjEn.Next
            If Not (pGxObj Is Nothing) And TypeOf pGxObj Is IGxThumbnail Then
                
                'set thumbnail without going through metadata
                Dim pGxThumb As IGxThumbnail
                Dim pPict As Picture
                Set pGxThumb = pGxObj
                Set pPict = pGxThumb.Thumbnail
                If Not (pPict Is Nothing) Then
                    
                    Dim pMD As IMetadata
                    Dim pXPS As IXmlPropertySet2
                    Set pMD = pGxSelObj
                    Set pXPS = pMD.Metadata
                    
                    pXPS.SetPropertyX "Binary/Thumbnail/Data", pPict, _
                        esriXPTPicture, esriXSPAAddOrReplace, False
                    pMD.Metadata = pXPS
                End If
                
            End If
        End If
        
        Dim pGxView As IGxView
        Set pGxView = pGxApp.View
        If TypeOf pGxView Is IGxDocumentationView Then pGxView.Refresh
        
    End If
    
End Sub

Additional Requirements

Reference to "OLE Automation"