Public Function ExportFeatclass() As IFeatureClass
Dim pFeatureClass As IFeatureClass
Dim lpOutWorkspaceName As IWorkspaceName
Dim lpOutFCName As IFeatureClassName
Dim lpOutDatasetName As IDatasetName
Dim lsTableName As String
Dim lpDataSet As IDataset
Dim lpInDatasetName As IDatasetName
Dim lpFields As IFields
Dim liIdx As Integer
Dim lpShapeF As IField
Dim lpFieldEdit As IFieldEdit
Dim lpGeoDef As IGeometryDef
Dim lpGeoDefEdit As IGeometryDefEdit
Dim lpExpOp As IExportOperation
Dim lpName As IName
Dim pmap As IMap
Dim pDoc As IMxDocument
Set pDoc = Application.Document
Set pmap = pDoc.FocusMap
Dim player As ILayer
Set player = pmap.Layer(0)
Dim pFeaturelayer As IFeatureLayer
Set pFeaturelayer = player
Set pFeatureClass = pFeaturelayer.FeatureClass
Dim pWorkspace As IWorkspace
Dim TheQueryFilt As ISpatialFilter
Set TheQueryFilt = New SpatialFilter
TheQueryFilt.WhereClause = ""
lsTableName = pFeaturelayer.Name
Set pWorkspace = CreateWorkspace()
Set lpOutWorkspaceName = New WorkspaceName
lpOutWorkspaceName.WorkspaceFactoryProgID = "esriDataSourcesGDB.AccessWorkspaceFactory"
lpOutWorkspaceName.ConnectionProperties = pWorkspace.ConnectionProperties
Set lpOutFCName = New FeatureClassName
Set lpOutDatasetName = lpOutFCName
Set lpOutDatasetName.WorkspaceName = lpOutWorkspaceName
lpOutDatasetName.Name = lsTableName
Set lpDataSet = pFeatureClass
Set lpInDatasetName = lpDataSet.FullName
Set lpFields = pFeatureClass.Fields
'lpShapeF = TheInputF.Fields.Field(TheInputF.Fields.FindField(TheInputF.ShapeFieldName))
For liIdx = 0 To lpFields.FieldCount - 1
If lpFields.Field(liIdx).Type = esriFieldType.esriFieldTypeGeometry Then
Set lpShapeF = lpFields.Field(liIdx)
Exit For
End If
Next
If lpShapeF Is Nothing Then
Exit Function
End If
Set lpFieldEdit = lpShapeF
Set lpGeoDef = New GeometryDef
Set lpGeoDefEdit = lpGeoDef
lpGeoDefEdit.GeometryType = pFeatureClass.ShapeType
Set lpGeoDefEdit.SpatialReference = pFeatureClass.Fields.Field(pFeatureClass.Fields.FindField(pFeatureClass.ShapeFieldName)).GeometryDef.SpatialReference
Set lpFieldEdit.GeometryDef = lpGeoDef
Set lpExpOp = New ExportOperation
lpExpOp.ExportFeatureClass lpInDatasetName, TheQueryFilt, Nothing, lpGeoDef, lpOutFCName, 0
Set lpName = lpOutFCName
End Function
Public Function CreateWorkspace() As IWorkspace
Dim lpWorkspaceFactory As IWorkspaceFactory
Dim lpWorkspace As IWorkspace
Dim lpPropSet As IPropertySet
Dim lpName As IName
Set lpWorkspaceFactory = New AccessWorkspaceFactory
Set lpPropSet = New PropertySet
lpPropSet.SetProperty "DATABASE", "D:\Temp\CLH\CLH.MDB"
Set lpName = lpWorkspaceFactory.Create("D:\Temp\CLH", "CLH.MDB", lpPropSet, 0)
Set lpWorkspace = lpName.Open()
'Return lpWorkspace
Set CreateWorkspace = lpWorkspace
End Function
When i am running this code in VBA acrobjects i am facing following error . Please help me anybody
Run-time error '2147467259(80004005)';
Automationi Error
Unspecified Error
