Sub GetGenusValue
Dim objForm, objPage, genusValue, genusText
Set objForm = Application.Applets("fillForm").Forms("FORM1")
Set objPage = objForm.Pages("PAGE1")
genusValue = objPage.Controls("cboGenus").Value
genusText = objPage.Controls("cboGenus").Text
'MsgBox genusValue & " " & genusText
Call GetSpeciesValue(genusValue,objPage)
End Sub
Sub GetSpeciesValue(genusValue,objPage)
objPage.Controls("cboSpecies").Clear
Dim objRS
Set objRS = Application.CreateAppObject("RecordSet")
objRS.Open(preferences.properties("AppletsPath") & "\Species.dbf")
objRS.MoveFirst
Call objPage.Controls("cboSpecies").AddItemsFromTable(preferences.properties("AppletsPath") & "\Species.dbf", "Species", "Species", ("[GID]= " & genusValue))
objRS.Close
End Sub
I am new to ArcPAD Studio and have a similar issue. Is it possible you can connect me to discuss. I need to auto fill some fields
Option Explicit
'**********************************************************************************
'THIS IS THE VBS FILE FOR "DEPENDENT LISTS"
'Dependent Lists" are lists that display different sets of choices
'depending on the value chosen in another list.
'This VBS file needs to be in the same directory as the layer file
'**********************************************************************************
Sub LoadDependentList (strTargetComboName, strTableName)
'**********************************************************************************
'Procedure: LoadDependentList
'Purpose: Puts a filtered set of list values into a combobox
' based on the value of another combobox.
'Arguments: strTargetComboName - the name of the combobox to receive the new list
' strTableName - the full name of the table containing the "Master" list of values
' if its in same directory as edit layer then the path can be omitted
' (assumes the table has 3 fields: field1 - the field to filter on;
' field2 - the combobox value; field3 - the combobox text)
'**********************************************************************************
Dim rs 'recordset to open the table containing values to go into target combobox
Dim strFilter 'the value of the ComboBox that has triggered the OnSelChange event
Dim strFieldName 'the name of the field to filter on
Dim strSearch
Dim lngFound
Dim lngBM
Dim cboFilter
Dim pge
Dim strValueField
Dim strTextField
If "" & strTableName = "" Then
Exit Sub
End If
Set cboFilter=thisevent.object
Set pge=cboFilter.parent
strFilter=cboFilter.value
'strFilter=pge.controls("cboFeature").value
'msgbox strFilter
Set rs=Application.CreateAppObject("recordset")
If instr(strTableName, "\")=0 Then
'if the table name does not contain a backslash character then
'it does not contain the path to the table, so we assume its in the
'same directory as the layer being edited - call the LayerPath function
'to get the directory the table is located in
strTableName = LayerPath & strTableName
End If
On Error Resume Next
err.clear
rs.open(strTableName)
If err.number<>0 Then
msgbox "Cannot open Table " & strTableName
Set rs=Nothing
Set cboFilter=Nothing
Set pge=Nothing
Exit Sub
End If
strFieldName=rs.fields.item(1).name
'msgbox strFieldName
'msgbox LayerPath
strSearch="[" & strFieldName & "]=""" & strFilter & """"
strValueField = rs.fields(2).name
strTextField = rs.fields(3).name
pge.controls(strTargetComboName).additem "",""
pge.controls(strTargetComboName).clear
'record find loop not needed - see AddItemsFromTable method below, with optional filter argument
'correction, loop is needed, I'm sick of trying to get the AddItemsFromTable method to work with a filter argument
lngFound=rs.find(strSearch)
While lngfound>0
lngBM=rs.bookmark
pge.controls(strTargetComboName).additem rs.fields(2),rs.fields(3)
lngFound=rs.find(strSearch,,lngBM)
Wend
'stop
rs.close
'cant get this to work
'pge.controls(strTargetComboName).AddItemsFromTable strTableName, strValueField, strTextField, strSearch
Set rs=Nothing
Set pge=Nothing
Set cboFilter=Nothing
End Sub
Function LayerPath
'returns the path of the edit layer
Dim lyr
Dim strPath
Set lyr=application.map.SelectionLayer '1 is the editable points layer
strPath = lyr.FilePath
strPath=left(strPath,InstrRev(strPath,"\",-1,1))
LayerPath=strPath
End Function