Solved! Go to Solution.
Dim objLayer, objRS, objRect, myQuery, myRec, myValue Set objLayer=application.map.layers("My Layer Name") myValue = 357799 Set objRS=objLayer.records If (Not objRS Is Nothing) Then objRS.MoveFirst For i = 0 To objRS.RecordCount - 1 If objRS.Fields("FieldName").Value = myValue Then myRec = i+1 End If objRS.MoveNext Next End If If (myRec > 0) Then 'Zoom to feature Set objRect=objRS.Fields.Shape.Extent Call objRect.ScaleRectangle(0.5) Application.Map.Extent = objRect Application.Map.Refresh Else msgbox "Feature Not Found!" End If Set objRect = Nothing Set objLyr = Nothing Set objRS = Nothing Set pDS = Nothing
Sub SelectAndZoomTo Dim objLayer, objRS, objRect, myQuery, myRec, myValue Set objLayer=application.map.layers("My Layer Name") myValue = "Lookup Value" Set objRS=objLayer.records myQuery = "[FieldName]= """ & myValue & """ myRec = objRS.Find(myQuery) 'If feature is found If (myRec > 0) Then objRS.movefirst objRS.move(myRec-1) Set objRect=objRS.Fields.Shape.Extent Map.Extent=objRect 'If feture is Not found Else msgbox "Feature NOT Found!" End If Map.Refresh End Sub
Dim objLayer, objRS, objRect, myQuery, myRec, myValue Set objLayer=application.map.layers("My Layer Name") myValue = 357799 Set objRS=objLayer.records If (Not objRS Is Nothing) Then objRS.MoveFirst For i = 0 To objRS.RecordCount - 1 If objRS.Fields("FieldName").Value = myValue Then myRec = i+1 End If objRS.MoveNext Next End If If (myRec > 0) Then 'Zoom to feature Set objRect=objRS.Fields.Shape.Extent Call objRect.ScaleRectangle(0.5) Application.Map.Extent = objRect Application.Map.Refresh Else msgbox "Feature Not Found!" End If Set objRect = Nothing Set objLyr = Nothing Set objRS = Nothing Set pDS = Nothing