vba 输出featureclass export featureclass

Sub export()


        Dim pDoc     As IMxDocument
        Dim pMap     As IMap
        Dim pFLayer     As IFeatureLayer
        Dim pFc     As ifeatureclass
        Dim pINFeatureClassName     As IFeatureClassName
        Dim pDataset     As IDataset
        Dim pInDsName     As IDatasetName
        Dim pFSel     As IFeatureSelection
        Dim pSelSet     As ISelectionSet
        Dim pFeatureClassName     As IFeatureClassName
        Dim pOutDatasetName     As IDatasetName
        Dim pWorkspaceName     As IWorkspaceName
        Dim pExportOp     As IExportOperation

        Set pDoc = ThisDocument
        Set pMap = pDoc.FocusMap
        Set pFLayer = pMap.Layer(0)
        Set pFc = pFLayer.FeatureClass
        

        
        Dim pFeatureCursor As IFeatureCursor
        Set pFeatureCursor = pFc.Search(Nothing, False)
        
        Dim pFeature As IFeature
        Set pFeature = pFeatureCursor.NextFeature
        
        Dim i As Integer
        i = 0
        


Do Until pFeature Is Nothing


          pMap.SelectFeature pFLayer, pFeature
          

        'Get   the   FcName   from   the   featureclass
        Set pDataset = pFc
        Set pINFeatureClassName = pDataset.FullName
        Set pInDsName = pINFeatureClassName

        'Get   the   selection   set
        Set pFSel = pFLayer
        Set pSelSet = pFSel.SelectionSet

        'Define   the   output   feature   class   name
        Set pFeatureClassName = New FeatureClassName
        Set pOutDatasetName = pFeatureClassName
        pOutDatasetName.Name = "NewTestExport" & i
        Set pWorkspaceName = New WorkspaceName
        pWorkspaceName.PathName = "c:\temp "
        pWorkspaceName.WorkspaceFactoryProgID = _
                    "esriDataSourcesFile.ShapefileWorkspaceFactory"

        Set pOutDatasetName.WorkspaceName = pWorkspaceName
        pFeatureClassName.FeatureType = esriFTSimple
        pFeatureClassName.ShapeType = esriGeometryAny
        pFeatureClassName.ShapeFieldName = "Shape "

        'Export
        Set pExportOp = New ExportOperation
        pExportOp.ExportFeatureClass pInDsName, Nothing, _
                      pSelSet, Nothing, pOutDatasetName, 0
                      
                      
        i = i + 1
        
        pMap.ClearSelection

    Set pFeature = pFeatureCursor.NextFeature
Loop



'Select Example
'Dim pFeatcls As ifeatureclass
'Dim pFeatLayer As IFeatureLayer
'Dim pDoc As IMxDocument
'Dim pMap As IMap
'Set pDoc = ThisDocument
'Set pMap = pDoc.Maps.Item(0)
'Set pFeatLayer = pMap.Layer(0)
'Set pFeatcls = pFeatLayer.FeatureClass
''create the query filter, and give it a where clause
'Dim pQFilt As IQueryFilter
'Set pQFilt = New QueryFilter
'pQFilt.WhereClause = "FID > 1"
''use the query filter to select features
'
'Dim pSelectionSet As ISelectionSet 'When calling Select the selectionContainer parameter is no longer required. Nothing (VB6) should be supplied it its place.
'Set pSelectionSet = pFeatcls.Select(pQFilt, esriSelectionTypeIDSet, esriSelectionOptionNormal, Nothing)    'count the number of selected features
'
'Dim pActiveView As IActiveView
'Set pActiveView = pMap
'
'
'pActiveView.Refresh
'
'
'MsgBox pSelectionSet.Count
'
MsgBox "finished"



End Sub