'''''*****ListView(VB 6) Selected or checked Data Entry & Display Solutions full code*****''''
Option Explicit
Public CN As ADODB.Connection ''General Declaration in Modules part''
Public RS As ADODB.Recordset ''General Declaration in Modules part''
Public Sub DBConn() ''Sub Procedure for Database in Modules part'''
Set CN = New ADODB.Connection
With CN
If .State = adStateOpen Then
.Close
End If
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = App.Path & "\DemoDB.mdb"
.ConnectionTimeout = 50
.Mode = adModeReadWrite
.CursorLocation = adUseClient
.Open
End With
End Sub
''''''''''************''''''''''''
Private Sub Form_Load()
DBConn ''Calling Proc from Module''
'''** ListView Design view and Properties'''
With ListView2
With .ColumnHeaders
.Add 1, , "SL", 300, lvwColumnLeft
.Add 2, , "Name Id", 1200, lvwColumnLeft
.Add 3, , "Customer Name", 2000, lvwColumnLeft
.Add 4, , "Products/Items", 2250, lvwColumnLeft
.Add 5, , "Amount/Qty", 1250, lvwColumnRight
.Add 6, , "CustNo", 1000, lvwColumnRight
End With
.Appearance = cc3D
.LabelEdit = lvwManual
.BorderStyle = ccFixedSingle
.View = lvwReport
.GridLines = True
.HideSelection = True
.FullRowSelect = True
.HideColumnHeaders = False
.AllowColumnReorder = True
.Checkboxes = True
.LabelWrap = True
End With
'''**************'''''''''''''''
End Sub
Private Sub cmdPopulate_Click() '''''Data Load in ListView control'''''''''
Dim itmX As ListItem
Set RS = New ADODB.Recordset
RS.Open "tblCustomer", CN, adOpenForwardOnly, adLockReadOnly, adCmdTableDirect
If RS.RecordCount Then
ListView2.ListItems.Clear
Do While Not RS.EOF
Set itmX = ListView2.ListItems.Add '''''(, , CStr(ListView1.ListItems.Count + 1))
With RS
itmX.SubItems(1) = !CustID
itmX.SubItems(2) = !CustName
itmX.SubItems(3) = !CustItem
itmX.SubItems(4) = !CustAmount
itmX.SubItems(5) = !CustNo
End With
RS.MoveNext
Loop
'''''''''''''''''''''''''''''
''''''''''For Set Focus on last entry row And Vertical Schroll Bar Showing'''''''
With ListView2
If Not itmX Is Nothing Then
itmX.EnsureVisible
.ListItems(itmX.Index).Selected = True
.SetFocus
End If
End With
''''''''''''''''
RS.Close
Set RS = Nothing
Else
MsgBox "Records not found in the Database.", vbInformation, "SDM."
cboCustIdName.SetFocus
RS.Close
Set RS = Nothing
Exit Sub
End If
''''''''''''''
End Sub
Private Sub cmdListView_SaveCheckedItem_Click()
'''''ListView Checked Item Data entry to Database'''
On Error GoTo Rollback_Err
''''''''''''''''
CN.BeginTrans
Dim x As Integer
For x = ListView2.ListItems.Count To 1 Step -1
Set RS = New ADODB.Recordset
RS.Open "tblCustomer", CN, adOpenKeyset, adLockPessimistic, adCmdTableDirect
If ListView2.ListItems(x).Checked = True Then
With RS
.AddNew
!CustID = ListView2.ListItems(x).SubItems(1) '''Database Column and ListView subItem''
!CustName = ListView2.ListItems(x).SubItems(2)
!CustItem = ListView2.ListItems(x).SubItems(3)
!CustAmount = ListView2.ListItems(x).SubItems(4)
.Update
.Close
End With
End If
Next
Set RS = Nothing
CN.CommitTrans
''''''''''''''''''''''''
Exit Sub
Rollback_Err:
Me.MousePointer = vbDefault
Set RS = Nothing
CN.RollbackTrans
MsgBox Error$, 48, "Data Transaction Error."
''''''''''''''''''''
End Sub
