AnsweredAssumed Answered

copy field VBA for many shapefiles starting with C

Question asked by helenak on Apr 24, 2012
Latest reply on Apr 24, 2012 by mvolz47
Hello,

I created a VBA to generate a new field (A_new)(season) of polygon and then copy an existing field (A_old) to it.
(For ArcGIS desktop)

However, there are 500 shapefiles waiting for this task.
The file names are different but share the beginning of C. (For instance, C9568, C4803, and C3208)
Please kindly advise if there is any VBA code to copy the existing fields (C9568, C4803, and C3208)
to the new field with the same name (season) without doing it for 500 times.
Thanks a lot.


Code

Public Sub CreateField()
On Error GoTo eh:
       
Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
Dim pMap As IMap
Set pMap = pMxDoc.FocusMap
Dim pLayer As ILayer
Set pLayer = pMap.Layer(0)
Dim pFeatureLayer As IFeatureLayer
Dim pFeatureClass As IFeatureClass
If TypeOf pLayer Is IFeatureLayer Then
Set pFeatureLayer = pLayer
Else
Exit Sub
End If
Set pFeatureClass = pFeatureLayer.FeatureClass
Dim pField As IField
Dim pFieldedit As IFieldEdit
Set pField = New Field
Set pFieldedit = pField
With pFieldedit
.Name = "Season"
.AliasName = "Season"
.Type = esriFieldTypeString
.Length = 6
End With
pFeatureClass.AddField pField
Call UpdateFeatures
eh:
End Sub

Public Sub UpdateFeatures()
    Dim pFeatureClass As IFeatureClass
    Dim pFeatureLayer As IFeatureLayer
    Dim pDoc As IMxDocument
    Dim pMap As IMap
   
    Set pDoc = ThisDocument
    Set pMap = pDoc.Maps.Item(0)
    Set pFeatureLayer = pMap.Layer(0)
    Set pFeatureClass = pFeatureLayer.FeatureClass
   
    Dim pFeatureCursor As IFeatureCursor
    Dim pFeature As IFeature
   
    Set pFeatureCursor = pFeatureClass.Update(Nothing, False)
   
    '++++++ Loop through each feature and update
    Set pFeature = pFeatureCursor.NextFeature
    Do While Not pFeature Is Nothing
    pFeature.Value(pFeature.Fields.FindField("Season")) = pFeature.Value(pFeature.Fields.FindField("C9469"))
    pFeature.Store
    Set pFeature = pFeatureCursor.NextFeature
    Loop
End Sub

Outcomes