not exactly what you need but you can probably modify it to make it work for you.here is some code that selects featureas and exports the table selection to a text file...
Private Sub MakeHighwayDistrictBoundaryLists()
'finds unique values from pData.Field value in Polygon Layer
Dim pDoc As IMxDocument
Set pDoc = ThisDocument
Set pPointLayer = pDoc.FocusMap.Layer(0)
Set pPolyLayer = pDoc.FocusMap.Layer(10)
'Set Polygon Layer name for labelling output table
strLName = pPolyLayer.Name
strPolyVariable = "DISTRICT"
MakeList
End Sub
Private Sub MakeList()
Dim pDoc As IMxDocument
Set pDoc = ThisDocument
Dim pMap As IMap
Set pMap = pDoc.FocusMap
Dim pData As IDataStatistics
Dim pCursor As ICursor
Dim pEnumVar As IEnumVariantSimple
Dim pTable As ITable
Set pTable = pPolyLayer
Set pCursor = pTable.Search(Nothing, False)
Set pData = New DataStatistics
pData.Field = strPolyVariable
Set pData.Cursor = pCursor
Set pEnumVar = pData.UniqueValues
Value = pEnumVar.Next
Dim DiagCollection As New Collection
Dim Inst
Do Until IsEmpty(Value)
If Value = " " Then
Value = pEnumVar.Next
Else
'Selects Polygon form pPolyLayer that match the variable Value
Dim pSelectedPoly As IFeatureSelection
Set pSelectedPoly = pPolyLayer 'QI
Dim strQuery As String
If strPolyVariable = "ZIPCODE" Or strPolyVariable = "SANAREA" Or strPolyVariable = "DISTRICT" Then
strQuery = strPolyVariable & " = " & Value
Else
strQuery = strPolyVariable & " = " & "'" & Value & "'"
End If
'Set Polygon Layer field value labelling output table; getting rid of losts of stuff for outputting a valid fieldname every time
strFName = Replace(Replace(Replace(Replace(Value, "Weekly Bag Service + ", ""), " ", "_"), ",", "_and"), "/", "_")
Dim pFilter As IQueryFilter
Set pFilter = New QueryFilter
pFilter.WhereClause = strQuery
pSelectedPoly.SelectFeatures pFilter, esriSelectionResultNew, False
'select all features in pPointLayer that intersect the selected features in pPolyLayer (selected using pSelectedPoly)
Dim pFCur As IFeatureCursor
Set pFCur = pPointLayer.FeatureClass.Search(Nothing, False)
Dim pFSel2 As IFeatureSelection
Set pFSel2 = pPointLayer
'get the selection set for layer 1 and the ids for the selected features
Dim pSelectionSet As ISelectionSet
Dim pFSel1 As IFeatureSelection
Set pFSel1 = pPolyLayer
Set pSelectionSet = pFSel1.SelectionSet
Dim pEnumIDs As IEnumIDs
Set pEnumIDs = pSelectionSet.IDs
Dim pGeoCollection As IGeometryCollection
Set pGeoCollection = New GeometryBag
Dim i As Long
For i = 1 To pSelectionSet.Count
pGeoCollection.AddGeometry pPolyLayer.FeatureClass.GetFeature(pEnumIDs.Next).Shape
Next i
Dim pSpatialFilter As ISpatialFilter
Set pSpatialFilter = New SpatialFilter
With pSpatialFilter
Set .Geometry = pGeoCollection
.GeometryField = "Shape"
.SpatialRel = esriSpatialRelContains
End With
pFSel2.SelectFeatures pSpatialFilter, esriSelectionResultNew, False
Dim pSelectionSet2 As ISelectionSet
Dim pFSelect2 As IFeatureSelection
Set pFSelect2 = pPointLayer
Set pSelectionSet2 = pFSelect2.SelectionSet
If pSelectionSet2.Count > 0 Then
ExportSelSetFeatureLayertoTable
End If
End If
Value = pEnumVar.Next
Loop
End Sub
Public Sub ExportSelSetFeatureLayertoTable()
Dim pDoc As IMxDocument
Dim pMap As IMap
Set pDoc = ThisDocument
Set pMap = pDoc.FocusMap
' Get the selected layer
Dim pTable As ITable
Dim pFLayer As IFeatureLayer
Dim pSelItem As IUnknown
Set pSelItem = pDoc.SelectedItem
If pSelItem Is Nothing Then
MsgBox "Please select a feature feature layer."
Exit Sub
ElseIf TypeOf pSelItem Is IFeatureLayer Then
Set pFLayer = pSelItem
Set pTable = pFLayer.FeatureClass
Else
MsgBox "Please select a feature feature layer."
Exit Sub
End If
'Confirm layer to be used with user
' Get the dataset name for the input table
Dim pDataset As IDataset
Dim pDSName As IDatasetName
Set pDataset = pTable
Set pDSName = pDataset.FullName
' Get the output dataset name ready. In this
' case we are creating a text file in c:\temp
Dim pWkSpFactory As IWorkspaceFactory
Dim pWkSp As IWorkspace
Dim pWkSpDS As IDataset
Dim pWkSpName As IWorkspaceName
Dim pOutDSName As IDatasetName
Dim lblnValidFile As Boolean
Dim strFileName As String, strFileLocation As String
strFileName = strLName & strFName & ".txt"
strFileLocation = "V:\temp\"
Set pWkSpFactory = New TextFileWorkspaceFactory
Set pWkSp = pWkSpFactory.OpenFromFile(strFileLocation, 0)
Set pWkSpDS = pWkSp
Set pWkSpName = pWkSpDS.FullName
Set pOutDSName = New TableName
pOutDSName.Name = strFileName
Set pOutDSName.WorkspaceName = pWkSpName
Dim pQueryFilter As IQueryFilter
Set pQueryFilter = New QueryFilter
Dim strField1 As String, strField2 As String, strField3 As String, strField4 As String, strField5 As String, strField6 As String, strField7 As String
strField1 = "NAME"
strField2 = "PHONE"
strField3 = "ADDRESS"
strField4 = "CITY"
strField5 = "STATE"
strField6 = "ZIP"
strField7 = "COUNTY"
'Checking table for required fields
Dim colTableFields As New Collection
colTableFields.Add strField1
colTableFields.Add strField2
colTableFields.Add strField3
colTableFields.Add strField4
colTableFields.Add strField5
colTableFields.Add strField6
colTableFields.Add strField7
Dim strcolTableFields As Variant, chkFieldExists As Long, strProblemMessage As String
For Each strcolTableFields In colTableFields
chkFieldExists = pTable.FindField(strcolTableFields)
If chkFieldExists = -1 Then
strProblemMessage = strProblemMessage & "Missing field in " & pDataset.Name & ": " & strcolTableFields & vbCrLf
End If
Next
If strProblemMessage <> "" Then
MsgBox "Problem with fields. " & vbCrLf & strProblemMessage
'End
' Stop
Exit Sub
End If
Dim strSubFields As String
'Once residential and commercial is implemented, strField7 should not be exported
strSubFields = strField1 & ", " & strField2 & ", " & strField3 & ", " & strField4 & ", " & strField5 & ", " & strField6 & ", " & strField7
pQueryFilter.SubFields = strSubFields
Dim pFeatureSel As IFeatureSelection
Set pFeatureSel = pFLayer
Dim pSelSet As ISelectionSet2
Set pSelSet = pFeatureSel.SelectionSet
' Export selected set of records to text file
Dim pExpOp As IExportOperation
Set pExpOp = New ExportOperation
pExpOp.ExportTable pDSName, pQueryFilter, pSelSet, pOutDSName, Application.hWnd
'Not required can comment out after debugging
' add the table to map
Dim pName As IName
Dim pNewTable
Dim pStTab As IStandaloneTable
Dim pStTabColl As IStandaloneTableCollection
Set pName = pOutDSName
Set pNewTable = pName.Open
Set pStTab = New StandaloneTable
Set pStTab.Table = pNewTable
Set pStTabColl = pMap
pStTabColl.AddStandaloneTable pStTab
pDoc.UpdateContents
End Sub
