I am facing problem while exporting featureclass. Can anybody help me pls

683
0
04-06-2011 06:34 PM
sundaramoorthikrishnan
New Contributor II
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
0 Kudos
0 Replies