Page History
...
Source Code ActiveX Example 3 - Visual Basic - Code
Option Explicit
Public Session As LANSA_ACTIVEX_LIB.Session
Dim axobjecta As LANSA_AXOBJECTA_LIB.axobjecta
Dim axobjectb As LANSA_AXOBJECTB_LIB.axobjectb
Dim gbDirty As Boolean
Dim gbDepartment As String * 3
Dim lvwindex As Long
Private Sub Form_Load()
' login to LANSA using default user, password and session location
If Session Is Nothing Then
Call ConnectToLansa("<user name>", "<password>", "<session.cfg path>")
End If
Set axobjecta = Session.CreateComponent("AXOBJECTA")
Set axobjectb = Session.CreateComponent("AXOBJECTB")
' dynamically create columns for list view
MakeColumns
GetEmployees ("")
End Sub
Private Sub GetEmployees(ByVal gbDepartment)
...
StatusMsgBox.Clear
StatusMsgBox.AddItem ("Building Employee List")
...
' build collection of all employees for initial display
If gbDepartment = "" Then
' build collection of all employees
Call axobjectb.uGetAllEmployees(gbDirty)
Else
Call axobjectb.uGetDepartEmployees(gbDepartment, gbDirty)
End If
StatusMsgBox.Clear
If UCase(gbDirty) = True Then ' if returned in error
StatusMsgBox.AddItem ("Error when building list")
Else:
NewAddListItems ' add items to list
StatusMsgBox.AddItem ("Employees selected")
...
End If
End Sub
Private Sub cmdSearch_Click()
cmdback.Enabled = False
cmdforward.Enabled = False
StatusMsgBox.Clear
StatusMsgBox.AddItem ("Building Employees for Department")
' build collection of all employees for initial display
Call axobjectb.uGetDepartEmployees(uDepartment, gbDirty)
If gbDirty = True Then
StatusMsgBox.AddItem ("Department not found")
' clear list view
lvwemployees.ListItems.Clear
Else:
' add items to list
NewAddListItems ' add items to list
StatusMsgBox.AddItem (Str$(axobjectb.uEmployees.ItemCount) + " Employees selected")
End If
End Sub
Private Sub NewAddListItems()
Dim employeeli As ListItem
Dim employeesi As ListSubItem
Dim employeeobject As LANSA_AXOBJECTA_LIB.axobjecta
On Error GoTo ErrorHandler
...
' clear list view
lvwemployees.ListItems.Clear
gbDirty = axobjectb.uGetNextEmployee
Do While gbDirty = False
lvwindex = lvwindex + 1
Set employeeobject = axobjectb.uCurrentEmployee
Set employeeli = lvwemployees.ListItems.Add(, _
employeeobject.uNumber)
Call employeeli.ListSubItems.Add(, "surname", employeeobject.uSurname)
Call employeeli.ListSubItems.Add(, "department", employeeobject.uDepartment)
Call employeeli.ListSubItems.Add(, "givenname", employeeobject.uGiveName)
Call employeeli.ListSubItems.Add(, "salary", employeeobject.uSalary)
gbDirty = axobjectb.uGetNextEmployee
...
Loop
Exit Sub ' Exit to avoid handler.
ErrorHandler: ' Error-handling routine.
MsgBox ("Error :" + Err.Description)
End Sub
Private Sub lvwemployees_ItemClick(ByVal Item As ListItem)
On Error GoTo ErrorHandler
Dim employeeli As ListItem
cmdback.Enabled = True
cmdforward.Enabled = True
cmdUpdate.Enabled = True
...
Set employeeli = lvwemployees.SelectedItem
lvwindex = Item.Index
Call GetEmployee(lvwindex)
Exit Sub ' Exit to avoid handler.
ErrorHandler: ' Error-handling routine.
MsgBox ("Error :" + Err.Description)
End Sub
Private Sub GetEmployee(lvwindex)
Dim employeeobject As LANSA_AXOBJECTA_LIB.axobjecta
On Error GoTo ErrorHandler
Call axobjectb.uSetCurrentEmployee(lvwindex)
Set employeeobject = axobjectb.uCurrentEmployee
uNumber = employeeobject.uNumber
uSurname = employeeobject.uSurname
uGiveName = employeeobject.uGiveName
uSalary = employeeobject.uSalary
Exit Sub ' Exit to avoid handler.
ErrorHandler: ' Error-handling routine.
MsgBox ("Error :" + Err.Description)
End Sub
Private Sub cmdback_Click()
...
If lvwindex > 1 Then
lvwindex = lvwindex - 1
GetEmployee (lvwindex)
End If
End Sub
Private Sub cmdforward_Click()
If lvwindex < lvwemployees.ListItems.Count Then
lvwindex = lvwindex + 1
End If
GetEmployee (lvwindex)
End Sub
Private Sub cmdUpdate_Click()
Dim Status As String
Dim employeeobject As LANSA_AXOBJECTA_LIB.axobjecta
On Error GoTo ErrorHandler
If uSalary = "" Then uSalary = 0
Set employeeobject = axobjectb.uCurrentEmployee
With employeeobject
.uGiveName = uGiveName
.uSurname = uSurname
.uSalary = uSalary
End With
Status = employeeobject.uSaveEmployee
' Clear the Messages from the Message Combo
StatusMsgBox.Clear
If (Status = "OK") Then
MsgBox ("Successfully updated " + employeeobject.uNumber)
Else
Call ShowMessages(Status, employeeobject)
MsgBox ("Error Updating " + employeeobject.uNumber + " : " + Status)
End If
Exit Sub ' Exit to avoid handler.
ErrorHandler: ' Error-handling routine.
MsgBox ("Error :" + Err.Description)
End Sub
Private Sub ShowMessages(ByRef Status As String, ByRef employeeobject As LANSA_AXOBJECTA_LIB.axobjecta)
Dim msgField As Object
On Error GoTo ErrorHandler
For Each msgField In employeeobject.uMessages
StatusMsgBox.AddItem (msgField.Value())
Next
' Select the first entry in the combo box
If (StatusMsgBox.ListCount = 0) Then
StatusMsgBox.AddItem ("Status = '" + Status + "'")
End If
StatusMsgBox.ListIndex = 0
Exit Sub ' Exit to avoid handler.
ErrorHandler: ' Error-handling routine.
MsgBox ("Error :" + Err.Description)
End Sub
...
Private Sub MakeColumns()
' Clear the ColumnHeaders collection.
lvwemployees.ColumnHeaders.Clear
' Add four ColumnHeaders.
lvwemployees.ColumnHeaders.Add , , "", 0
lvwemployees.ColumnHeaders.Add , , "Surname", 1500
lvwemployees.ColumnHeaders.Add , , "Department"
lvwemployees.ColumnHeaders.Add , , "Given Name"
lvwemployees.ColumnHeaders.Add , , "Salary"
lvwemployees.View = lvwReport
...
End Sub
Private Sub ConnectToLansa(ByVal username As String, ByVal password As String, ByVal txtlocation As String)
...
On Error GoTo ErrorHandler
Set Session = New LANSA_ACTIVEX_LIB.Session
' Set the session configuration file
Session.ConfigFile = txtlocation
Call Session.SetConnectParam("USER", username)
Call Session.SetConnectParam("PSPW", password)
Call Session.Connect
Exit Sub ' Exit to avoid handler.
ErrorHandler: ' Error-handling routine.
MsgBox ("Error :" + Err.Description)
End Sub