Hi Community,
I have an old VBA tool collection (wrote in VBA and works well up to ArcGIS 10.2). Now I have upgraded to ArcGIS 10.3.1 and it throws an error.
It use the Mouse-Down_Procedure to get attributes from the clicked object. The error throwns at Set pMxApp = Application
Erronumber: 13
ErrDescription: Type mismatch
CODE:
'##########################################################################################################
Private Sub ClickMe_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
'from Sample Select By Location
Dim pMxApp As IMxApplication
Dim pMxDoc As IMxDocument
Dim pMap As IMap
Dim pActiveView As IActiveView
Dim pPoint As IPoint
Dim pFeature As IFeature
Dim pEnvelope As IEnvelope
Dim pFS As IFeatureSelection
Dim pFCursor As IFeatureCursor
Dim pLayer As IFeatureLayer
Dim sURL As String 'Hyperlink
Dim sUser As String
'On Error GoTo ClickMe_MouseDown_Error
'set parameters
Set pMxApp = Application 'that doesn't works in ArcMap 10.3
Set pMxDoc = ThisDocument
Set pMap = pMxDoc.FocusMap
Set pActiveView = pMap
'set Layer to select object from
For i = 0 To pMap.LayerCount - 1
Debug.Print pMap.Layer(i).Name
If pMap.Layer(i).Name = "LayerA" Then
Set pLayer = pMap.Layer(i)
End If
Next i
Set pEnvelope = pMxDoc.CurrentLocation.Envelope
pEnvelope.Expand 10, pMxDoc.SearchTolerance, False 'pMxDoc.SearchTolerance
'Refresh the old selection to erase it
pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
'Perform the selection using a point created on mouse down
pMap.SelectByShape pEnvelope, pMxApp.SelectionEnvironment, True '
'Refresh again to draw the new selection
pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
'here have to check NULL-Value before!
If Not pFeature Is Nothing Then
'Build URL String If found NULL then "no data"
If IsNull(pFeature.Value(pFeature.Fields.FindField("Username"))) = False Then
sUser= pFeature.Value(pFeature.Fields.FindField("Username"))
Else
sUser= "no data"
End If
.......
End if
Set pFeature = Nothing
Set pPoint = Nothing
Set pActiveView = Nothing
Set pMxDoc = Nothing
Exit Sub
ClickMe_MouseDown_Error:
If Err.Number = 91 Or Err.Number = 94 Then
Exit Sub
Else
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ClickMe_MouseDown of VBA Dokument ThisDocument"
End If
'############################################################################################################
Did anyone can someone give me a hint? I need to select a feature from MouseDown (point) and parse the attribute table for getting all the information from this clicked point to display in an own form....
thx at all
Kai
