Field.Shape = Point
I had this code working in ArcPad 8. When I tried to bring it over to ArcPad 10, I keep getting an error. The error is "Error Source Unavailable", "Error Description: Unavailable".
Basically, the user clicks on the map, a form pops up, user enters information, then information is saved to that point. Point is then created and placed on map. Here's the code and the error comes up when it hits "pField.Shape = pPt":
Sub SaveFieldData()
Dim pControls, pCtl, pPt
Dim pLayer, pRS, pFields
Dim sDate, sTime, sTeam, sLocation, sLat, sLon, sMeasurement, sUnits, sMeasuringLocal, sMeasuring, sSymbolId, sComments
Set pControls = Application.Forms("frmFieldData").Pages("PAGE1").Controls
Set pLayer = Map.Layers("Field Data")
pLayer.Editable = True
Set pRS = pLayer.Records
Set pFields = pRS.Fields
Dim editRecord, sMeasId, sOrigDataId, sDataId, sLocalEdit, sSaveEditFlag
editRecord = Application.UserProperties("EditRecord")
Set pCtl = pControls("edtDate")
sDate = pCtl.Value
Set pCtl = pControls("edtTime")
sTime = pCtl.Value
Set pCtl = pControls("cboTeam")
sTeam = pCtl.Value
Set pCtl = pControls("edtLocation")
sLocation = pCtl.Value
Set pCtl = pControls("edtLat")
sLat = pCtl.Value
Set pCtl = pControls("edtLon")
sLon = CDbl(pCtl.Value)
Set pCtl = pControls("edtMeasured")
sMeasurement = pCtl.Value
Set pCtl = pControls("cboUnits")
sUnits = pCtl.Value
Application.UserProperties("LastUnits") = sUnits
Set pCtl = pControls("cboMeasurementType")
sMeasuring = pCtl.Text
sMeasuringLocal = pCtl.Value
Application.UserProperties("LastMeasurementType") = sMeasuringLocal
Set pCtl = pControls("cboPlotCategory")
sSymbolId = pCtl.Value
Application.UserProperties("LastPlotCategory") = sSymbolId
Set pCtl = pControls("edtComments")
sComments = pCtl.Value
If editRecord > 0 Then
pRS.Bookmark = editRecord
Else
pRS.AddNew
End If
' project the point into map coordinates
Dim dblX, dblY
dblX = CDbl(sLon)
dblY = CDbl(sLat)
Call ProjectLLToMap (dblX, dblY)
' add to the recordset
Set pPt = Application.CreateAppObject ("Point")
pPt.X = dblX
pPt.Y = dblY
If editRecord > 0 Then
sMeasId = pFields("meas_id").Value
sDataId = pFields("data_id").Value
sLocalEdit = "E"
Else
sMeasId = -1
sDataId = Application.UserProperties("MinDataId")
sLocalEdit = "C"
End If
If sDataId < 0 Then
Application.UserProperties("MinDataId") = Application.UserProperties("MinDataId") - 1
End If
pFields("SITE_NAME").Value = Application.UserProperties("Sitename")
pFields("DATETIME").Value = CDate(sDate & " " & sTime)
pFields("TEAM").Value = sTeam
pFields("TIMESTAMP").Value = CDate(Now)
pFields("AUTHOR").Value = sTeam
pFields("LOCATION").Value = sLocation
pFields("LONGITUDE").Value = sLon
pFields("LATITUDE").Value = sLat
pFields("CATEGORY").Value = Application.UserProperties("Category")
pFields("UNITS").Value = sUnits
pFields("MEASURING").Value = sMeasuring
pFields("COMMENTS").Value = sComments
pFields("DATA_ID").Value = sDataId
pFields("SYMBOL_ID").Value = sSymbolId
pFields("LABEL").Value = sMeasurement & "," & sUnits & "," & sMeasuringLocal
pFields("MEAS_ID").Value = sMeasId
pFields("MEASUREMNT").Value = sMeasurement
pFields("EDIT_SYM").Value = sSymbolId & sSaveEditFlag
Set pFields.Shape = pPt
pRS.Update
Sub ProjectMapToLL (dblX, dblY)
'Create a Point object (which inherits the map's coordsys)
Dim pPt
Set pPt = Application.CreateAppObject ("Point")
'Assign the X and Y values to the point object
pPt.X = dblX
pPt.Y = dblY
'Create a NAD1983 Lat/Lon CoordSys object
Dim pLatLonCS
Set pLatLonCS = Application.CreateAppObject ("CoordSys")
pLatLonCS.Import Application.UserProperties("DefaultPath") & "\Coordinate Systems\North American Datum 1983.prj"
'Unproject the point to WGS 1984 Lat/Lon
Dim pUnproj
Set pUnproj = pLatLonCS.Project (pPt)
dblX = pUnproj.X
dblY = pUnproj.Y
'Clean up
Set pPt = Nothing
Set pLatLonCS = Nothing
Set pUnProj = Nothing
End Sub
