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
