SDE服务器端的图层增减 VBA实现一下

Private Sub CommandButton1_Click() '向SDE服务器添加本地shape文件

    If TextBox1.Text = "" Then
        MsgBox "缺少上传文件！", vbCritical, "警告"
        Exit Sub
    End If
     
    Dim fWor As IFeatureWorkspace
    Dim wFac As IWorkspaceFactory
    Dim fCla1 As IFeatureClass, fCla2 As IFeatureClass
    Dim proSet As IPropertySet
    Dim fCount As Integer
    Dim fea As IFeatureBuffer
    Dim geo As IGeometry
   
    Dim sFile, sName, sPath As String
    sFile = TextBox1.Text
    sPath = sFile
    sName = Right(sPath, 1)
    Do While Not (sName = "\")
        sPath = Left(sPath, Len(sPath) - 1)
        sName = Right(sPath, 1)
    Loop
    sName = Right(sFile, Len(sFile) - Len(sPath))
    sPath = Left(sPath, Len(sPath) - 1)
    Set wFac = New ShapefileWorkspaceFactory
    Set fWor = wFac.OpenFromFile(sPath, None)
    Set fCla1 = fWor.OpenFeatureClass(sName)
    fCount = fCla1.FeatureCount(Nothing)
   
    Set wFac = New SdeWorkspaceFactory
    Set proSet = New PropertySet
    proSet.SetProperty "server", "yj-gis2"
    proSet.SetProperty "instance", "5151"
    proSet.SetProperty "user", "sde"
    proSet.SetProperty "password", "sde"
    proSet.SetProperty "version", "DEFAULT"
    Set fWor = wFac.Open(proSet, 0)
    Set fCla2 = fWor.CreateFeatureClass(fCla1.AliasName, fCla1.Fields, fCla1.CLSID, fCla1.EXTCLSID, fCla1.FeatureType, fCla1.ShapeFieldName, None)
   
    Dim wEdit As IWorkspaceEdit
    Set wEdit = fWor
    wEdit.StartEditing True
    wEdit.StartEditOperation
   
    For i = 0 To fCount - 1
        Set fea = fCla2.CreateFeatureBuffer
        Set geo = fCla1.GetFeature(i).ShapeCopy
        Set fea.Shape = geo
        Dim fdCount As Integer
        fdCount = fCla1.Fields.FieldCount
        For j = 0 To fdCount - 1
            fea.Value(j) = fCla1.GetFeature(i).Value(j)
        Next j
        fCla2.Insert(True).InsertFeature (fea)
    Next i
   
    wEdit.StopEditOperation
    wEdit.StopEditing True
       
   
    MsgBox "添加成功！", vbInformation, "提示"

End Sub

Private Sub CommandButton2_Click() '将SDE服务器上的图层删除

    Dim fName As String
    fName = ComboBox1.Text
   
    Dim fWor As IFeatureWorkspace
    Dim wFac As IWorkspaceFactory
    Dim proSet As IPropertySet
    Dim fSet As IDataset
   
    Set wFac = New SdeWorkspaceFactory
    Set proSet = New PropertySet
    proSet.SetProperty "server", "yj-gis2"
    proSet.SetProperty "instance", "5151"
    proSet.SetProperty "user", "sde"
    proSet.SetProperty "password", "sde"
    proSet.SetProperty "version", "DEFAULT"
    Set fWor = wFac.Open(proSet, None)
    Dim wor As IWorkspace
    Set wor = fWor
   
    Set fSet = fWor.OpenFeatureClass(fName)
    fSet.Delete
   
    MsgBox "删除成功！", vbInformation, "提示"

End Sub

Private Sub CommandButton3_Click() '浏览本地shape文件
    
    CommonDialog1.Filter = "Shape File|*.shp"
    CommonDialog1.FileName = ""
    CommonDialog1.ShowOpen
    If CommonDialog1.FileName <> "" Then
        TextBox1.Text = CommonDialog1.FileName
    End If
  
End Sub

Private Sub CommandButton4_Click() '在下拉菜单中列出SDE服务器上的图层

    ComboBox1.Text = ""
    ComboBox1.Clear
   
    Dim fWor As IFeatureWorkspace
    Dim wFac As IWorkspaceFactory
    Dim proSet As IPropertySet
   
    Set wFac = New SdeWorkspaceFactory
    Set proSet = New PropertySet
    proSet.SetProperty "server", "yj-gis2"
    proSet.SetProperty "instance", "5151"
    proSet.SetProperty "user", "sde"
    proSet.SetProperty "password", "sde"
    proSet.SetProperty "version", "DEFAULT"
    Set fWor = wFac.Open(proSet, None)
    Dim wor As IWorkspace
    Set wor = fWor
    Dim eSet As IEnumDataset
    Set eSet = wor.Datasets(esriDTFeatureClass)
    Dim fCla As IFeatureClass
    Set fCla = eSet.Next
    While Not fCla Is Nothing
        ComboBox1.AddItem fCla.AliasName
        Set fCla = eSet.Next
    Wend
   
    MsgBox "更新成功！", vbInformation, "提示"

End Sub