免费视频|新人指南|投诉删帖|广告合作|地信网APP下载

查看: 3372|回复: 1
收起左侧

如何创建DBF文件附代码

[复制链接]

1986

主题

10万

铜板

98

好友

技术员

Network change life, change t

积分
17879

斑竹勋章地信元老

QQ
发表于 2009-12-15 09:04 | 显示全部楼层 |阅读模式
本例要实现的是如何创建一个单独的DBF文件。
l   要点
首先设定DBF文件的字段个数,再创建新的IField对象,生成新字段,设置其属性,再加入到IFields对象中,最后用IFeatureWorkspace.CreateTable方法创建一个新的DBF文件并返回ITable对象。
主要用到IField接口,IFieldEdit接口,IFields接口,IFieldsEdit接口。
l   程序说明
函数CreateDBF根据输入的路径和文件名创建一个DBF文件并返回一个ITable对象。
l   代码
Private Function CreateDBF (sFilePath As String, sFileName As String) As ITable
'createDBF: simple function to create a DBASE file.
'note: the name of the DBASE file should not contain the .dbf extension
On Error GoTo ErrorHandler:
    Dim pFeatureWorkspace           As IFeatureWorkspace
    Dim pWorkspaceFactory           As IWorkspaceFactory
    Dim FileFolder                  As New scripting.FileSystemObject
    Dim pFieldsEdit                 As esriCore.IFieldsEdit
    Dim pFieldEdit                  As esriCore.IFieldEdit
    Dim pFields                     As IFields
    Dim pField                      As IField
    Dim sDir                        As String
    'Open the Workspace
    Set pWorkspaceFactory = New ShapefileWorkspaceFactory
    If Not FileFolder.FolderExists(sFilePath) Then
        MsgBox "路径不存在" & vbCr & sFilePath
        Exit Function
    End If
    sDir = Dir(sFilePath & sFileName & ".dbf")
    If (sDir <> "") Then
        MsgBox ("文件已存在")
        Exit Function
    End If
    Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(sFilePath, 0)
    'if a fields collection is not passed in then create one
    'create the fields used by our object
    Set pFields = New esriCore.Fields
    Set pFieldsEdit = pFields
    pFieldsEdit.FieldCount = 6
    'Create text Fields
    Set pField = New Field
    Set pFieldEdit = pField
    With pFieldEdit
        .Name = "SmallInteger"
        .Type = esriFieldTypeSmallInteger
    End With
    Set pFieldsEdit.Field(0) = pField
    Set pField = New Field
    Set pFieldEdit = pField
    With pFieldEdit
        .Name = "Integer"
        .Type = esriFieldTypeInteger
    End With
    Set pFieldsEdit.Field(1) = pField
    Set pField = New Field
    Set pFieldEdit = pField
    With pFieldEdit
        .Name = "Single"
        .Type = esriFieldTypeSingle
    End With
    Set pFieldsEdit.Field(2) = pField
    Set pField = New Field
    Set pFieldEdit = pField
    With pFieldEdit
        .Precision = 5
        .Scale = 5
        .Name = "Double"
        .Type = esriFieldTypeDouble
    End With
    Set pFieldsEdit.Field(3) = pField
    Set pField = New Field
    Set pFieldEdit = pField
    With pFieldEdit
        .Length = 30
        .Name = "String"
        .Type = esriFieldTypeString
    End With
    Set pFieldsEdit.Field(4) = pField
    Set pField = New Field
    Set pFieldEdit = pField
    With pFieldEdit
        .Name = "Date"
        .Type = esriFieldTypeDate
    End With
    Set pFieldsEdit.Field(5) = pField
    Set createDBF = pFeatureWorkspace.CreateTable(sFileName, pFields, Nothing, Nothing, "")
    sDir = Dir(sFilePath & sFileName & ".dbf")
    If (sDir <> "") Then
        MsgBox ("Build Success")
    Else
        MsgBox ("Build Fail")
    End If
    Exit Function
ErrorHandler:
    MsgBox Err.Description
End Function
Private Sub UIButtonControl1_Click()
    Dim pVBProject              As VBProject
    Dim pTable                  As ITable
On Error GoTo ErrorHandler:
    Set pVBProject = ThisDocument.VBProject
    'Dont include .dbf extension
    Set pTable = CreateDBF (pVBProject.FileName & "\..\..\..\.." & "\data\", "MyDBFFile")
    Exit Sub
ErrorHandler:
    MsgBox Err.Description
End Sub
轻轻的我来签到了,想带走一堆铜板...

1145

主题

10万

铜板

2

好友

传奇会员

Rank: 30Rank: 30Rank: 30Rank: 30Rank: 30Rank: 30Rank: 30Rank: 30

积分
21818

灌水勋章活跃勋章冰雪节勋章

QQ
发表于 2013-11-10 20:19 | 显示全部楼层
进来看看 学习学习

评分

参与人数 1铜板 +1 收起 理由
admin + 1 亲,你好快哦~~~

查看全部评分

加强科技支撑和引领  实现地质找矿新突破 。     
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

在线客服
快速回复 返回顶部 返回列表