[分享代码]对shape文件添加字段

<TABLE width="100%">

<TR>
<TD class=subtitle colSpan=6>内容摘要</TD></TR>
<TR>
<TD class=txt colSpan=6>要求:只能对非加载的shape进行操作,对于加的,必须移除,并且与该层相关的对象必须清空</TD></TR>
<TR>
<TD class=subtitle colSpan=6>过程描述</TD></TR>
<TR>
<TD class=txt colSpan=6>Public Sub FieldAppender(dbPath As String, _
　　　　　　　　　　　　Filename As String, _
　　　　　　　　　　　　newFldname As String, _
　　　　　　　　　　　　NewFldType As String, _
　　　　　　　　　　　　newFldsize As Integer)
　　　　　　　　　　　　
　Dim db As Database
　Dim tdf1 As TableDef, tdf2 As TableDef
　Dim ndx1 As Index, ndx2 As Index
　Dim fld1 As DAO.Field, fld2 As DAO.Field
　Dim sql As String
　
　Set db = OpenDatabase(dbPath, False, False, "dBase IV;")
　Debug.Print db.Updatable
　Dim i As Integer
　For i = 0 To db.TableDefs.Count - 1
　　If db.TableDefs(i).Name = Filename Then
　　　Set tdf1 = db.TableDefs(Filename)
　　End If
　　DoEvents
　Next i
　If tdf1 Is Nothing Then
　　MsgBox "没有找到该shapefile文件。", vbOKOnly
　　Exit Sub
　End If
　
　For i = 0 To db.TableDefs.Count - 1
　　If db.TableDefs(i).Name = "SHENYU" Then
　　　sql = "Drop Table Shenyu"
　　　db.Execute sql
　　End If
　　DoEvents
　Next i
　
　Set tdf2 = New TableDef
　tdf2.Name = "Shenyu"
　
　For Each fld1 In tdf1.Fields
　　Set fld2 = New DAO.Field
　　fld2.Name = fld1.Name
　　fld2.Type = fld1.Type
　　fld2.Size = fld1.Size
　　tdf2.Fields.Append fld2
　　DoEvents
　Next fld1
　
　Set fld2 = New DAO.Field
　
　fld2.Name = newFldname
　fld2.Type = NewFldType
　fld2.Size = newFldsize
　
　tdf2.Fields.Append fld2
　
　db.TableDefs.Append tdf2
　
　sql = "Insert into Shenyu Select * from " ; Filename
　db.Execute sql
　
　Set tdf1 = Nothing
　
　sql = "Drop Table " ; Filename
　db.Execute sql
　
　tdf2.Name = Filename
　
　db.Close
　Set db = Nothing
　Exit Sub
　
ErrorHandler:
　db.Close
　Set db = Nothing
　Exit Sub
End Sub</TD></TR></TABLE>

非常感谢！

cool!