data.txt

将矢量要素导入到指定数据库的数据集中

发一个数据入库的代码

'****************************************************************
'函数功能：  将矢量要素导入到指定数据库的数据集中，可以将shapefile，dxf，coverage格式导入倒GEodatabase中
'  参数表：
'            pInDatasetNameCol      一个存储要导入的矢量要素（IFeatureClassName类型）的Collection对象
'            pOutNameCol            一个存储导入的矢量要素名称（string类型）的Collection对象
'            strGDBPath             包含矢量要素数据集名称的GDB路径，如“D:\world\Map3D.mdb”
'****************************************************************
Public Function convFeatureClass(pInDatasetNameCol As Collection, pOutNameCol As Collection, strGDBPath As String)
'获得导入数据的数目
Dim iInFCNum As Integer
iInFCNum = pInDatasetNameCol.Count
'获得输出的数据库名和数据集名
Dim sOutFDSName As String
Dim sOutGDBName As String
sOutFDSName = GetPathName(strGDBPath, 1)
sOutGDBName = GetPathName(strGDBPath, 0)
'获得输出要素集的IFeatureDatasetName
Dim pWSF As IWorkspaceFactory
Set pWSF = New AccessWorkspaceFactory
Dim pWS As IWorkspace
Set pWS = pWSF.OpenFromFile(sOutGDBName, 0)
Dim pOutFeatureWS As IFeatureWorkspace
Set pOutFeatureWS = pWS
'获得输出要素集的Dataset Name
Dim pOutFDSName As IFeatureDatasetName
Dim pOutFDS As IFeatureDataset
Set pOutFDS = pOutFeatureWS.OpenFeatureDataset(sOutFDSName)
Set pOutFDSName = pOutFDS.FullName
Dim i As Integer
For i = 1 To iInFCNum
    Dim pOutPropertySet As IPropertySet
    Set pOutPropertySet = New PropertySet
    pOutPropertySet.SetProperty "DATASET", sOutGDBName
    
    Dim pOutWorkspaceName As IWorkspaceName
    Set pOutWorkspaceName = New WorkspaceName
    pOutWorkspaceName.ConnectionProperties = pOutPropertySet
    pOutWorkspaceName.WorkspaceFactoryProgID = "esriDataSourcesGDB.AccessWorkspaceFactory.1"
    
    '设置输出要素的FeatureClass Name
    Dim pOutFCName As IFeatureClassName
    Set pOutFCName = New FeatureClassName
    Dim pDatasetName As IDatasetName
    Set pDatasetName = pOutFCName
    Set pDatasetName.WorkspaceName = pOutWorkspaceName
    
    pDatasetName.name = pOutNameCol.Item(i)
    
    '获得输入要素的FeatureClass Name
    Dim pInDatasetName As IDatasetName
    Set pInDatasetName = pInDatasetNameCol.Item(i)
    '判断是否有重名现象
    Dim pWS2 As IWorkspace2
    Set pWS2 = pWS
    
    '如果名称已存在
    If pWS2.NameExists(esriDTFeatureClass, pDatasetName.name) Then
        Dim R
        R = MsgBox("矢量要素" & pDatasetName.name & "在数据库中已存在!" & Chr(13) & "是否覆盖?", vbExclamation + vbYesNo)
        '覆盖原矢量要素
        If R = vbYes Then
            Dim pFWS As IFeatureWorkspace
            Set pFWS = pWS
            Dim pDataset As IDataset
            Set pDataset = pFWS.OpenFeatureClass(pDatasetName.name)
            pDataset.Delete
            
            Set pFWS = Nothing
            Set pDataset = Nothing
            
        '不覆盖,则退出for循环,忽略这个要素,转入下一个要素的导入
        Else
            GoTo NextStep
        End If
        
        Set pWS2 = Nothing
        
    End If
    
    '打开Table获得Fields
    Dim pname As IName
    Dim pInTable As ITable
    Set pname = pInDatasetName
    Set pInTable = pname.Open
    
    Dim pInFields As IFields
    Set pInFields = pInTable.Fields
    
    '检查Field Name
    Dim pFieldChecker As IFieldChecker
    Set pFieldChecker = New FieldChecker
    Dim pOutFields As IFields
    pFieldChecker.Validate pInFields, Nothing, pOutFields
    
    '对Fields进行循环查，查找Geometry域
    Dim j As Integer
    Dim pGeoField As IField
    For j = 0 To pOutFields.FieldCount - 1
        If pOutFields.Field(j).Type = esriFieldTypeGeometry Then
            Set pGeoField = pOutFields.Field(j)
            Exit For
        End If
    Next j
    
    '获得Geometry Field的GeometryDef
    Dim pOutFCGeoDef As IGeometryDef
    Set pOutFCGeoDef = pGeoField.GeometryDef
    
    '设置GeometryDef的GridCount，GridSize，SpatialReference
    Dim pOutFCGeoDefEdit As IGeometryDefEdit
    Set pOutFCGeoDefEdit = pOutFCGeoDef
    pOutFCGeoDefEdit.GridCount = 1
    pOutFCGeoDefEdit.GridSize(0) = DefaultIndexGrid(pInTable)
    
    Dim re
  
     '判断空间参考是否一致，全局变量m_SpatialRef是创建的矢量要素集的空间参考
    If m_SpatialRef.name <> pGeoField.GeometryDef.SpatialReference.name Then
        re = MsgBox(pInDatasetName.name & "的空间参考与数据库中的矢量要素集空间参考不符！" & Chr(13) _
                & "导入后会丢失数据。     是否继续导入？", vbYesNo + vbExclamation)
        Set pOutFCGeoDefEdit.SpatialReference = m_SpatialRef
        If re = vbNo Then
            GoTo NextStep
       End If
    Else
        Set pOutFCGeoDefEdit.SpatialReference = pGeoField.GeometryDef.SpatialReference
    End If
    '+++++++++++++++++++
    'Set pOutFCGeoDefEdit.SpatialReference = pGeoField.GeometryDef.SpatialReference
    
    '进行导入
     Dim pConverter As IFeatureDataConverter
     Set pConverter = New FeatureDataConverter
     
     pConverter.ConvertFeatureClass pInDatasetNameCol.Item(i), Nothing, pOutFDSName, pOutFCName, pOutFCGeoDef, pOutFields, "", 1000, 0
     
     Set pOutPropertySet = Nothing
     Set pOutWorkspaceName = Nothing
     Set pOutFCName = Nothing
     Set pDatasetName = Nothing
     Set pInDatasetName = Nothing
     Set pname = Nothing
     Set pInTable = Nothing
     Set pFieldChecker = Nothing
     Set pOutFields = Nothing
     Set pGeoField = Nothing
     Set pOutFCGeoDef = Nothing
     Set pConverter = Nothing
     
   
NextStep:
Next i
Set pWSF = Nothing
Set pWS = Nothing
End Function



楼主你的这个有点问题：
'设置输出要素的FeatureClass Name
    Dim pOutFCName As IFeatureClassName
    Set pOutFCName = New FeatureClassName
    Dim pDatasetName As IDatasetName
    Set pDatasetName = pOutFCName
    Set pDatasetName.WorkspaceName = pOutWorkspaceName
    pDatasetName.name = pOutNameCol.Item(i)
    
输入是这样的，但是输出怎么又是这样的。
    '获得输入要素的FeatureClass Name
    Dim pInDatasetName As IDatasetName
    Set pInDatasetName = pInDatasetNameCol.Item(i)