6 51 1 VB Example

LANSA Open Guide

6.51.1 VB Example

Public Type FIELD_DETAIL

    fieldLen As Long

    flags As Long

End Type

 

Sub SetEmployeesList()

    Dim i As Integer

    Dim fldData(3) As FIELD_DETAIL

 

    ' clear list

    lstEmployees.Clear

    If cmbSection.ListIndex = -1 Then 

Exit Sub ' no department do nothing

    End If 

 

    ' Select data

    iRet = LceSetSelectOptions(iSession, "*RECEIVEIMMED")

    ' set keys value  department/section

    If iRet = LceTrue Then _

       iRet = LceSetFieldValue(iSession, "DEPTMENT", _

                 DeptKey(cmbDepartment.ListIndex))

    If iRet = LceTrue Then _

       iRet = LceSetFieldValue(iSession, "SECTION", _

                 SectKey(cmbSection.ListIndex))

    ' Request data

    If iRet = LceFalse then exit sub ' Failed

 

    If txtSurname = "" Then ' no surname search

       iRet = LceRequestSelect(iSession, "EMPNO,SURNAME,GIVENAME", _

            "PSLMST1", "DEPTMENT,SECTION", False)

    Else

       iRet= LceRequestSelectWhere(iSession, _

          "EMPNO,SURNAME,GIVENAME", _

          "PSLMST1", "DEPTMENT,SECTION", _

          "DEPTMENT *EQ " & _

          DeptKey(cmbDepartment.ListIndex))

 

    End If

 

    If iRet = LceTrue Then

        sBuff = String(FIELD_DATA_SIZE * 3 , Chr(0)) ' plenty of space

        i = 0

        ReDim EmpKey(0)

        ' Read all records

        While (LceReceiveNextX(iSession, sBuff, FIELD_DATA_SIZE * 3, fldData(0), 3) _

               = LceTrue) 

            ReDim Preserve EmpKey(i + 1)

            ' Only RDML fields retrieved so can assume starting positions are in fixed positions

            lstEmployees.AddItem (sTrim(Mid(sBuff, 28, 20)) _

                         & " " & sTrim(Mid(sBuff, 7, 20))) ' Full Name

            EmpKey(i) = sTrim(Left(sBuff, 5)) ' EmpNo

            i = i + 1

        Wend

        ' Select first on list

        If lstEmployees.ListCount > 0 Then lstEmployees.ListIndex = 0

   else

       ' failed

       …

    End If

End Sub