vba, export footprint of rastercatalog

Sub exportfeatureclass()

Dim pfws As IFeatureWorkspace
Set pfws = OpenFeatureWorkspace

Dim prwse As IRasterWorkspaceEx
Set prwse = OpenSDEGeodatabase

Dim prc As IRasterCatalog
Set prc = prwse.OpenRasterCatalog("ORI002009002乌海")

ExportFootprint2 prc, pfws, "newfeatureclass"


End Sub
'open ifeatureworkspace
Function OpenFeatureWorkspace() As IFeatureWorkspace

Dim pwsf As IWorkspaceFactory
Set pwsf = New ShapefileWorkspaceFactory

Dim pws As IWorkspace
Set pws = pwsf.OpenFromFile("D:\tangdi", 0)

Dim pfws As IFeatureWorkspace
Set pfws = pws

Set OpenFeatureWorkspace = pfws

End Function



' Open an ArcSDE geodatabase
Function OpenSDEGeodatabase() As IRasterWorkspaceEx
    Dim pConn As IPropertySet
    Set pConn = New PropertySet
   
    With pConn
        .SetProperty "server", "zhyxkserver"
        .SetProperty "instance", "5151"
        .SetProperty "user", "prjzhyxksde"
        .SetProperty "password", "prjzhyxksde"
        .SetProperty "version", "sde.DEFAULT"
    End With
   
    Dim pFact As IWorkspaceFactory
    Set pFact = New SdeWorkspaceFactory
   
    Set OpenSDEGeodatabase = pFact.Open(pConn, 0)
   
End Function


  Public Sub ExportFootprint2(pCatalog As IRasterCatalog, pOutWs As IFeatureWorkspace, sName As String)
' This procedure exports the footprint column of a raster catalog to a featureclass
 
    Dim pFeatCls As IFeatureClass
    Dim pFldsEdit As IFieldsEdit
    Dim pFldEdit As IFieldEdit
    Dim pOutFeatCls As IFeatureClass
    Dim pCursor As IFeatureCursor
    Dim pFeature As IFeature
    Dim pRow As IRow
   ' QI IFeatureClass
    Set pFeatCls = pCatalog

   ' Create fields with OID, NAME and SHAPE columns
    Set pFldsEdit = New Fields
    Set pFldEdit = New Field
    pFldEdit.Name = "OBJECTID"
    pFldEdit.Type = esriFieldTypeOID
    pFldsEdit.AddField pFldEdit
   
    Set pFldEdit = New Field
    pFldEdit.Name = "NAME"
    pFldEdit.Type = esriFieldTypeString
    pFldsEdit.AddField pFldEdit
   
    Set pFldEdit = New Field
    pFldEdit.Name = "SHAPE"
    pFldEdit.Type = esriFieldTypeGeometry

   ' Get shape fieldname and index from the rastercatalog
    Dim sGeo As String
    sGeo = pFeatCls.ShapeFieldName
    Dim iShape As Integer
    iShape = pFeatCls.FindField(sGeo)

   ' Set the geometrydef from the shape field in the raster catalog
    Set pFldEdit.GeometryDef = pFeatCls.Fields.Field(iShape).GeometryDef
    pFldsEdit.AddField pFldEdit

   ' Create output featureclass
    Set pOutFeatCls = pOutWs.CreateFeatureClass(sName, pFldsEdit, Nothing, Nothing, esriFTSimple, "SHAPE", "")

   ' Get cursor from the raster catalog
    Set pCursor = pFeatCls.Search(Nothing, False)
    Set pFeature = pCursor.NextFeature

   ' Loop through all items and extract NAME and SHAPE column values
    Do While Not pFeature Is Nothing
        Set pRow = pOutFeatCls.CreateFeature
        'NAME column
        pRow.Value(2) = pFeature.Value(pCatalog.NameFieldIndex)
        'SAHPE column
        pRow.Value(1) = pFeature.Value(iShape)
        pRow.Store
        Set pFeature = pCursor.NextFeature
    Loop

    'Cleanup
    Set pFeatCls = Nothing
    Set pFldsEdit = Nothing
    Set pFldEdit = Nothing
    Set pOutFeatCls = Nothing
    Set pCursor = Nothing
    Set pFeature = Nothing
    Set pRow = Nothing
   
End Sub