Load Listview from Recordset
Routine to load Listview from recordset
'Initialize our listview and columnheaders
ListView1.View = lvwList ' lvwReport
'If ListView1 <> "" Then LVClient.Picture = LoadPicture(LVBackImage)
Set oList = New cListView
' oList.SetBackgroundImage App.Path & "\back.gif"
With oList
.InitializeListview ListView1, GetUserformHwnd(Me)
.SetHeaderFontStyle 1
.PrimaryIndex = "ID"
'.AddColumnheaders "ID", "UserID", 70
.AddColumnheaders "Status", "CustomText2", 50 '
.AddColumnheaders "Production Order", "WONumber", 100
.AddColumnheaders "Customer Facing #", "CustomerFacing", 100
.AddColumnheaders "Material Desc", "MaterialDesc", 100
.AddColumnheaders "GTIN #", "GTIN", 100
.AddColumnheaders "MRP Controller", "MRPController", 100
.AddColumnheaders "Batch Qty", "OrdCount", 100
.AddColumnheaders "Packaging", "UOMDescription", 70
.AddColumnheaders "Release Date", "DDate", 70
'.AddColumnheaders "UserName", "Username", 100
'.AddColumnheaders "FirstName", "FirstName", 100
'.AddColumnheaders "LastName", "LastName", 100
'.AddColumnheaders "Company", "Company", 1500
End With
Private Sub LoadWorkOrderHdr()
On Error GoTo LocalErr
Dim rsHdr As ADODB.Recordset
Dim oWorkOrderHdr As New WorkOrderHdr
bIsLoading = True
ClearControls Me
CurWorkID = 0
ListView1.ListItems.Clear
Set rsHdr = oWorkOrderHdr.LoadRecords(txtDate.Text, DepID, CLng(cShiftCombo.ColValue), CLng(cLineCombo.ColValue))
If rsHdr.RecordCount <> 0 Then
With rsHdr
CurWorkID = .Fields("ID").Value '<- Set our Current WorkID
'CurWorkID = 0
'txtDate.Text = .Fields("DDate").Value
'txtShift.Text = .Fields("ShiftName").Value
'txtLine.Text = .Fields("LineText").Value
txtStatus.Text = .Fields("WOStatus").Value
'txtTotalBoxes.Text = .Fields("TotalBoxes").Value
'txtTotalPcs.Text = .Fields("TotalPcs").Value
End With
Call LoadRecords
Else
'No records found
' ListView1.ListItems(0).Text = "No records found."
End If
bIsLoading = False
Exit Sub
LocalErr:
MsgBox "Error in LoadWorkOrderHdr Sub() " & Err.DescriptionEnd Sub
Public Sub LoadRecords(Optional intPage As Long = 1)
On Error GoTo LocalErr
Dim objCmd As ADODB.Command
'Dim strFields As String
'ID,WOID,ProdCode,BatchNum,MaterialNum,WONumber,GTIN,MRPController,DDate,PackagingID,OrdCount,ActualCountBox,ActualCountPcs,Operators,Remarks,LastUpdate,UsrLastUpdate,CustomText1,CustomText2,CustomText3
'strFields = "a.ID,a.WOID,a.ProdCode,a.BatchNum,a.MaterialNum,a.WONumber,a.GTIN,a.MRPController,a.DDate,a.PackagingID,a.OrdCount,Sum(a.ActualCountBox) as BoxesActual,Sum(a.ActualCountPcs) as PcsActual,b.UomDescription,c.ProdFacingText as CustomerFacing,c.ProdDescription as MaterialDesc"
With SQLParser
.Fields = "a.*,b.UomDescription,c.ProdFacingText as CustomerFacing,c.ProdDescription as MaterialDesc"
.Tables = "((WorkOrderDetails a LEFT JOIN UOMTable b ON a.PackagingID = b.UomID) " & _
"LEFT JOIN Product c ON a.ProdCode = c.ProductID) "
.wCondition = "a.WOID = " & CurWorkID
'.GroupOrder = "a.ID,a.WOID,a.ProdCode,a.BatchNum,a.MaterialNum,a.WONumber,a.GTIN,a.MRPController,a.DDate,a.PackagingID,a.OrdCount,b.UomDescription,c.ProdFacingText,c.ProdDescription"
' Debug.Print .SQLStatement
End With
If Not IsValiD(RecordPage) Then Set RecordPage = New cPaging
Set objCmd = New ADODB.Command
'.CommandText = "sp_sel_CustomerListAll"
If rsOrders.State = adStateOpen Then rsOrders.Close
Set rsOrders = New ADODB.Recordset
With objCmd
.CommandType = adCmdText ' adCmdStoredProc
.CommandText = SQLParser.SQLStatement
Set .ActiveConnection = Conn
End With
'Debug.Print SQLParser.SQLStatement
With rsOrders
.CursorLocation = adUseClient
.Open objCmd, , adOpenStatic, adLockReadOnly
Set .ActiveConnection = Nothing
End With
With RecordPage
.Start rsOrders, numRecsPerPage
FillList intPage
End With
CurPage = intPage
'Save our original SQL
OrigSelectSQL = SQLParser.SQLStatement Set objCmd = Nothing
Exit Sub
LocalErr:
MsgBox "Error in LoadRecords Sub() " & Err.Description
End Sub
Private Sub FillList(ByVal whichPage As Long)
On Error GoTo LocalErr
CurPage = whichPage
RecordPage.CurrentPosition = whichPage
'Screen.MousePointer = vbHourglass
oList.ADOLoadRecords rsOrders, RecordPage.PageStart, RecordPage.PageEnd
'Screen.MousePointer = vbDefault
If intStatus = 0 Then
oList.ItemIndex = intSelected
End If
'SetNavigation 'Display the page information
'lblPageInfo.Caption = "Record " & RecordPage.PageInfo
'Display the selected record
'Update button state
Call GetTotalCount(CurWorkID)
If rsOrders.RecordCount <> 0 Then
cmdAdd.Enabled = True
cmdUpdate.Enabled = True
cmdDelete.Enabled = True
End If
' LVStock_Click
Exit Sub
LocalErr:
MsgBox Me.Name & " Sub FillList Error: " & Err.Description
End Sub
Unload all froms routine
Sub UnloadAll()
Dim frm As UserForm
Dim objLoop As Object
For Each objLoop In VBA.UserForms
If TypeOf objLoop Is UserForm Then
Set frm = objLoop
'If frm.Tag <> "MAINFORM" Then Unload objLoop
End If
Next
End Sub