VBA/Macro's help (newby alert!)

[DanielHardwick]

Hi guys,

First post here... I work in GIS, using ArcGIS 9.2, and I am a complete newby to VBA macro's scripts etc.
I hope this is the right place to post this (did a search for VBA and this thread seem to come up).

Basically I only started using VBA because a user wanted to add a count of unique values to one of his shapefiles, and then the count to appear in his legend.

The count field displays the count when in layer properies>unique values, but as soon as you come out of that the count ends.

So I found a macro which takes existing Unique Value and calculates feature counts for each value, adding the count to each Class Label. Class Labels appear in the ArcMap Table of Contents and Legend.

After a bit of trial and error I got the script to work. The problem is the script doesn't work on every shapefile, it works on some but not others.

Here is the script;

Const DESCRIP_FIELD = "STATE_NAME"
Const CONCATENATE_TO_BUILD_DESCRIPTION = True
Const CONCAT_CHAR = vbNewLine

Option Explicit

Sub UniqueValues_LabelCount_and_DescripFromField()

Dim pDoc As IMxDocument
Set pDoc = ThisDocument
Dim pMap As IMap
Set pMap = pDoc.FocusMap
Dim pGeoLayer As IGeoFeatureLayer
Set pGeoLayer = pMap.Layer(0)

If Not TypeOf pGeoLayer.Renderer Is IUniqueValueRenderer Then
MsgBox "Current symbology is not Unique values. Exiting."
Exit Sub
End If

Dim pUVRend As IUniqueValueRenderer
Set pUVRend = pGeoLayer.Renderer

If pUVRend.FieldCount > 1 Then
MsgBox "Current Unique values symbology is based on multiple fields. Exiting."
Exit Sub
End If

Dim sFieldName As String
sFieldName = pUVRend.Field(0)

Dim i As Integer
Dim varValue As Variant

Dim pFeatClass As IFeatureClass
Set pFeatClass = pGeoLayer.FeatureClass

Dim varLabelDescrip As Variant
For i = 0 To pUVRend.ValueCount - 1
varValue = pUVRend.Value(i)
varLabelDescrip = GetLabelDescription(pFeatClass, pUVRend.Field(0), varValue)
pUVRend.Label(varValue) = varLabelDescrip(0)
pUVRend.Description(varValue) = varLabelDescrip(1)
Next i

pDoc.ActiveView.ContentsChanged
pDoc.UpdateContents
pDoc.ActiveView.Refresh
End Sub

Private Function GetLabelDescription(pFeatClass As IFeatureClass, ValField As String, Value As Variant) As Variant
' returns an array of length 2
' (0) is the new label (string) appended with count of features
' (1) is the new descrip (string) driven from DESCRIP_FIELD

Dim pQueryFilter As IQueryFilter
Set pQueryFilter = New QueryFilter

pQueryFilter.WhereClause = ValField & " = '" & CStr(Value) & "'"
pQueryFilter.AddField DESCRIP_FIELD
Dim pFeatCursor As IFeatureCursor
Set pFeatCursor = pFeatClass.Search(pQueryFilter, False)

' ---------------------------------------------------------
' Description
Dim pFeat As IFeature
Dim sDescrip As String
Dim iDescrip As Integer
iDescrip = pFeatClass.Fields.FindField(DESCRIP_FIELD)
Set pFeat = pFeatCursor.NextFeature

Dim iCount As Integer
iCount = 0
Dim bCountsDetermined As Boolean
bCountsDetermined = False

If CONCATENATE_TO_BUILD_DESCRIPTION Then
bCountsDetermined = True
Do While Not pFeat Is Nothing
iCount = iCount + 1
If sDescrip <> "" Then sDescrip = sDescrip + CONCAT_CHAR
sDescrip = sDescrip + CStr(pFeat.Value(iDescrip)) ' get value from DESCRIP_FIELD
Set pFeat = pFeatCursor.NextFeature
Loop

Else ' only get descrip from first feature found
If Not pFeat Is Nothing Then
sDescrip = CStr(pFeat.Value(iDescrip)) ' get value from DESCRIP_FIELD
End If

End If

' ---------------------------------------------------------
' Label
If Not bCountsDetermined Then
' optimization: re-query only if we don't
' already have the counts from above
iCount = pFeatClass.FeatureCount(pQueryFilter)
End If
Dim sLabel As String
sLabel = Value & " (" & iCount & ") "

' ---------------------------------------------------------
' setup return array and return
Dim sReturnArray(2) As String
sReturnArray(0) = sLabel
sReturnArray(1) = sDescrip

GetLabelDescription = sReturnArray

End Function

I modify the constants for my particular data and situation (so essentially change 'STATE_NAME' to whatever the field im using is), it worked for the particular shapefile our user was using, but out of interest I tried it with a few other shapefiles, and it works for some and not others, the error message sometimes varies, but the latest one read ' Run-time error '-2147220985 (80040207) Automation error. The owner SID on a per-user subscription doesn't exist'.

Like I said above, I am a complete newby to this, and only started using it last week... it could be something obvious, so apologies if so.

Any help appreciated

Dan

[T__WayneWhitley]

Pretty certain it's your query encountering numeric values and not treating them as text properly...haven't tested this though.
Sounds like you can override the 'coercion'?  ...kind of 'intercept' the handoff of this value and convert to string before the error can be generated - it's an old post, but see:

The Owner SID on a per user subscription doesn't exist
http://forums.esri.com/Thread.asp?c=93&f=1148&t=209335

Particularly, the Oct 2008 post by Sebastian Good:

"...encountered this error when constructing a query filter for a shape file where the data type of the columns did not match, i.e. 'A>B' where A is a numeric column, and B is a text column. Normal SQL rules allow type coercion so I would expect ESRI to 'try' anyway (and in this case, column B was indeed all numbers, though in a text column), but it reported this error instead. This was under 9.2 SP4. My solution was to evaluate the predicate myself in the cursor."

[DanielHardwick]

Thanks Wayne, I will play around with it a bit more today and let you know how I get on.

Thanks
Dan

[DanielHardwick]

Well got this script to work, but it wasnt using the tips from above...

One of error messages related to 'Layer 0', and I noticed that the problem seemed to occur (in this particular isntance) to a shapefile I had half way down in my TOC, so I dragged the shapefile to the top of my TOC, and ran the macro again, and it worked.

I have tested this with another project, and it only seems to work when the shapefile is first in the TOC.

It's not something we will use everyday, so this solution will do for now!

Dan

[NeilClemmons]

Well got this script to work, but it wasnt using the tips from above...

One of error messages related to 'Layer 0', and I noticed that the problem seemed to occur (in this particular isntance) to a shapefile I had half way down in my TOC, so I dragged the shapefile to the top of my TOC, and ran the macro again, and it worked.

I have tested this with another project, and it only seems to work when the shapefile is first in the TOC.

It's not something we will use everyday, so this solution will do for now!

Dan

That's because your code is written to operate on the first layer in the TOC.

Set pGeoLayer = pMap.Layer(0)

[T__WayneWhitley]

Ah, those cryptic error messages...yes, ArcObjects VBA is fun, isn't it?  And therein lies the bonus round, in your statements "...error message sometimes varies..." and "One of error messages..." -- just trying to isolate them all is a daunting (sometimes futile) task!  So you get kudos for being one of the brave souls persistent enough to delve further into the ArcObjects world.

If this adds any convenience to what you are doing, you do not have to move your layers around - there are functions for searching for the layer in ArcMap's TOC, for example it's relatively straightforward to search by layer name, entering some variation of the famous 'FindLayerByName' function, as in this simple version:

Function FindLayerByName (pMap as IMap, sName as String) as ILayer
  Dim i as Integer
  For i = 0 to pMap.LayerCount -1
    If pMap.Layer(i).Name = sName Then
      Set FindLayerByName = pMap.Layer(i)
    End If
  Next
End Function

If you aren't familiar with this, you can simply paste this after you main subroutine.  How does it work?  pMap and sName are the map (an object) and layer name (a text string) that is passed in from your sub and passed back out to your sub as a result is a ILayer 'handle' or reference you need to the layer object.  The way you have your sub set up, you'd probably hardcode the string at the beginning for convenience, sort of like you have with your defined constants.  The beauty of it is, you are already defining pMap in your sub and the ILayer passed back out can be directly assigned to your pGeoLayer object.  [Your critical line is "Set pGeoLayer = pMap.Layer(0)"]

Hope that helps.  ArcObjects is powerful coding.  Enjoy. 

Oh, and honorable mention goes to Neil Clemmons - I don't work much with VBA at the moment and frankly don't remember much but know where to look.  You are working with 9.2 I think you said, so I searched the forum archives and Neil's post in 2005 was my 1st clue:

Find layer in TOC by name, then insert features
http://forums.esri.com/Thread.asp?c=93&f=992&t=165984&mc=1#msgid487921

Also, if you need it, the documentation library is here - old info, but still very potent:
http://edndoc.esri.com/arcobjects/9.2/welcome.htm

-Wayne

[DanielHardwick]

Thank you Wayne, a lot of that stuff is taking a while to settle in, as I am not familiar with VBA to be honest.

But it is certainly helping me to understand it more.

I gathered (after failing many times) that it was pointing to 'Layer(0)', but I had no clue if I could just go in and put something in like 'Layer(0)ANDLayer(1)' for example.

I will play around with 'FindLayerByName' and see how I get on

Thanks again.