Select to view content in your preferred language

adding and populating fields

546
0
04-20-2010 12:26 PM
VesselinaKonstantinova
New Contributor
Hello All
i am not a professional programmer and i have relative little experience with VBA, so i was wondering if anyone could provide me with some pointers on the following code.
it is designed to add and populate fields for objects which have the same attributes, it also specifies the field length.
from time to time the app crashes and it erases my entire table, another problem is that after I add a few fields and try to use a previous field length the app crashes again.

Option Explicit
Dim i As Integer
Dim x As Integer
Dim pMxDoc As IMxDocument
Dim pMap As IMap
Dim pTable As ITable
Dim pFeatClass As IFeatureClass
Dim pField As IField
Dim pFields As IFields
Dim pFieldEdit As IFieldEdit
Dim pFeatLayer As IFeatureLayer
Dim pCursor As IFeatureCursor
Dim pFeature As IFeature

Private Sub UserForm_Initialize()

Set pMxDoc = ThisDocument
Set pMap = pMxDoc.FocusMap

For i = 0 To pMap.LayerCount - 1
cbox.AddItem pMap.Layer(i).Name
Next i

End Sub

Private Sub cmdGetFields_Click()

Set pMap = pMxDoc.Maps.Item(0)
Set pFeatLayer = pMap.Layer(cbox.ListIndex)
Set pFeatClass = pFeatLayer.FeatureClass

Set pFields = pFeatClass.Fields

For i = 0 To pFields.FieldCount - 1
lboxFields.AddItem pFields.Field(i).AliasName
Next i

End Sub

Private Sub cmdClear_Click()
lboxFields.Clear
End Sub

Private Sub cmdAddField_Click()

Dim pFieldIndex As Integer
Set pMap = pMxDoc.Maps.Item(0)
Set pFeatLayer = pMap.Layer(cbox.ListIndex)
Set pFeatClass = pFeatLayer.FeatureClass
Set pFields = pFeatClass.Fields
   pFieldIndex = pFeatClass.FindField(tboxField.Text)
  If pFieldIndex <> -1 Then
   MsgBox "Field " & tboxField.Text & " Already Exists", vbOKOnly, "Result"
   Exit Sub
  End If
 
Dim newvalue As String
    If tboxValue.Text = Empty Then
     newvalue = "null"
    Else
     newvalue = tboxValue.Text
    End If
   
Dim val_len As Integer
If opt4.Value = True Then
val_len = 4
ElseIf opt50.Value = True Then
val_len = 50
ElseIf opt70.Value = True Then
val_len = 70
ElseIf opt100.Value = True Then
val_len = 100
Else
val_len = 50
End If

If tboxField.Text = "" Then
MsgBox "Please Enter a Name for the New Field", vbOKOnly, "Result"
Else
Set pField = New Field
Set pFieldEdit = pField

  With pFieldEdit
   .Length = val_len
   .Name = tboxField.Text
   .Type = esriFieldTypeString
  End With
  pFeatClass.AddField pField
End If
Set pCursor = pFeatClass.Update(Nothing, False)
Set pFeature = pCursor.NextFeature
x = 0
    Do Until pFeature Is Nothing
     x = x + 1
       pFeature.Value(pFeatClass.FindField(tboxField.Text)) = newvalue
      pCursor.UpdateFeature pFeature
     Set pFeature = pCursor.NextFeature
    Loop
 
lblCount.Caption = "Populated: " & x & " Rows"
MsgBox "New field " & tboxField.Text & " added and populated", vbOKOnly, "Result"
lblCount.Caption = ""
tboxField.Text = Empty
tboxValue.Text = Empty

End Sub


any suggestions would be helpful
Vesselina Konstantinova
0 Kudos
0 Replies