Runtime Error, pls help - Page 2

[styleest]

Yeah, i'm using vb 6.0, the list view code is below

Private Sub Init_Data()
On Error GoTo err:
If rs.State = adStateOpen Then rs.Close
Me.lvwInfo.ListItems.Clear
rs.Open "Select * from tblPayroll where Month(dDate)='" & Month(Me.dtPick.Value) & "' And Year(dDate)='" & Year(Me.dtPick.Value) & "' ORDER BY tblPayroll.EM_ID;", cn, adOpenKeyset, adLockPessimistic
Do While rs.EOF = False
Me.lvwInfo.ListItems.Add , , rs.Fields("EM_ID").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(1) = rs.Fields("EM_Name").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(2) = rs.Fields("Monthly_Rate").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(3) = rs.Fields("dDate").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(4) = rs.Fields("Bonus").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(5) = rs.Fields("OvertimePay").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(6) = rs.Fields("AwardTicket").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(7) = rs.Fields("FineTicket").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(8) = rs.Fields("pension").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(9) = rs.Fields("w/Tax").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(10) = rs.Fields("OtherDeductions").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(11) = rs.Fields("OtherEarnings").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(12) = rs.Fields("Loans").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(13) = rs.Fields("TotalDeductions").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(14) = rs.Fields("Medical").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(15) = rs.Fields("Housing").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(16) = rs.Fields("Transport").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(17) = rs.Fields("Furniture").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(18) = rs.Fields("Feeding").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(19) = rs.Fields("Miscellaneous").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(20) = rs.Fields("NetPay").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(21) = rs.Fields("RemainingBalance").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(22) = rs.Fields("TotalPaid").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(23) = rs.Fields("LoanCollected").Value
Me.lvwInfo.ListItems(Me.lvwInfo.ListItems.Count).SubItems(24) = rs.Fields("MonthlyDeduction").Value

rs.MoveNext
Loop

Exit Sub
err:
MsgBox err.Description, vbCritical, "Error"
Set rs = Nothing
End Sub

[styleest]

sori i dont know wat u mean by encasing my codes in a code tag

[AndreRet]

I'm getting there. What database are you using? access,sql, mysql?

[AndreRet]

sori i dont know wat u mean by encasing my codes in a code tag

In the reply box's top there is a label called "(CODE)". Click on this and enter your code in between the brackets, as in "(CODE)Code Here(/CODE)"

[styleest]

ok, i'm using access. i've thought of somtin, can i send the table alone and send the forms alone to you, maybe u can see them better that way and it will attach fats dat way

[AndreRet]

No, its fine. I'm almost done recreating your app. The only difference is that I will not be creating a report. I just want to see if the data is read fine.:)

[AndreRet]

Your problem is solved!!!!:)

Please read my contents in the code section.

[styleest]

i downloadded it and use winzip to extract it but the file is corrupt. pls can u re attach it? Thanks somuch for your effort

[AndreRet]

No problem. Heres the code as well -

'If this works for you, give me some reputation points for it. I've spend an hour and a half
'on getting your problem solved   :)How?
'In Daniweb under my last post to you, to the right of the post is 2 arrows, one up
' and one down. Select the up arrow to give me more reputation, please.:)

Option Explicit

Dim lstItem As ListItem

Private Sub cmdPrintSel_Click()

On Error GoTo err

'Make sure that there is data selected, otherwise an error is returned.

If lvwInfo.SelectedItem Is Nothing Then
    MsgBox "Please load data to listview first.", vbOKOnly + vbInformation, "Load data"
    
    dtPick.SetFocus
    
    Exit Sub
        Else
    Dim cnPrint As ADODB.Connection
    Set cnPrint = New ADODB.Connection
    
    Dim rsPrint As ADODB.Recordset
    Set rsPrint = New ADODB.Recordset
    Dim MyDate As Date
    Dim MyCon As String, MyString As String
    
    MyCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\MyData.MDB;Persist Security Info=False"
        
    cnPrint.Open MyCon
    
    If rsPrint.State = adStateOpen Then rsPrint.Close
     
    MyString = Me.lvwInfo.SelectedItem.Text
     
    dt1.Value = Me.lvwInfo.ListItems(Me.lvwInfo.SelectedItem.Index).SubItems(3)
    'Add MyDate value here....
    MyDate = dt1.Value
     
    If rsPrint.State = adStateOpen Then rsPrint.Close
    
    rsPrint.Open "SELECT " & _
    "EM_ID, EM_Name, Monthly_Rate, dDate, Bonus, OvertimePay, AwardTicket, FineTicket, pension, wTax, OtherDeductions, OtherEarnings, Loans, TotalDeductions, Medical, Housing, Transport, Furniture, Feeding, Miscellaneous, NetPay, RemainingBalance, TotalPaid, LoanCollected, MonthlyDeduction" & _
    " FROM tblPayroll WHERE EM_ID =" & "'" & MyString & "' GROUP BY " & _
    "EM_ID, EM_Name, Monthly_Rate, dDate, Bonus, OvertimePay, AwardTicket, FineTicket, pension, wTax, OtherDeductions, OtherEarnings, Loans, TotalDeductions, Medical, Housing, Transport, Furniture, Feeding, Miscellaneous, NetPay, RemainingBalance, TotalPaid, LoanCollected, MonthlyDeduction " & _
    "HAVING dDate >= DateValue('" & MyDate & "') ORDER BY EM_ID;", cnPrint, adOpenStatic, adLockOptimistic
    
    'Problem SOLVED!!!! Change your field in access "w/Tax to wTax", otherwise an error is returned...
    
    'Set drtSel.DataSource = rsPrint
    'drtSel.PrintReport
    'drtSel.Show 1
    
    rsPrint.Close
    cnPrint.Close
End If
    
    Exit Sub

err:
    MsgBox err.Description, vbCritical, "Error"
    rsPrint.Close
    cnPrint.Close
End Sub

Private Sub Init_Data()

Dim cnList As ADODB.Connection
Set cnList = New ADODB.Connection

Dim rsList As ADODB.Recordset
Set rsList = New ADODB.Recordset
Dim MyDate As Date
Dim MyCon As String
Dim xRecCount As Integer

MyCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\MyData.MDB;Persist Security Info=False"
    
cnList.Open MyCon

If rsList.State = adStateOpen Then rsList.Close

lvwInfo.ListItems.Clear

'I've changed the date statement as well!!!
rsList.Open "SELECT * from tblPayroll WHERE dDate >= DateValue('" & dtPick.Value & "') ORDER BY EM_ID", cnList, adOpenStatic, adLockOptimistic

If rsList.BOF = True Or rsList.EOF = True Then
    MsgBox "No records available for your selection", vbOKOnly + vbInformation, "No Records"
    
    rsList.Close
    cnList.Close
    Exit Sub
        Else
    'this is for adding the columns to the lv control
    Dim colx As ColumnHeader
    'this is for measuring column widths
    Dim colWidth As Double
    
    'checking the width of listview control and divided by 5...so that all columns become of same
    'width...here we used 25 because the control will have 25 columns
    colWidth = lvwInfo.Width / 5

    With lvwInfo
        .View = lvwReport
        .FullRowSelect = True
        .ColumnHeaders.Clear
        Set colx = .ColumnHeaders.Add(, , ("Emp Id"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Emp Name"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Month Rate"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Date"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Bonus"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Overtime"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Award Tckt"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Fine Tckt"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Pension"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("wTax"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Other Ded."), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Other Earn"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Loans"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Tot Deduct"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Medical"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Housing"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Transport"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Furniture"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Feeding"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Misc"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Net Pay"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Rem Balance"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Tot Paid"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Loan Coll"), colWidth)
        Set colx = .ColumnHeaders.Add(, , ("Month Deduct"), colWidth)
    End With

    Do While rsList.EOF = False
        With rsList
            Set lstItem = lvwInfo.ListItems.Add(, , !EM_ID)
            lstItem.SubItems(1) = !EM_Name
            lstItem.SubItems(2) = !Monthly_Rate
            lstItem.SubItems(3) = !dDate
            lstItem.SubItems(4) = !Bonus
            lstItem.SubItems(5) = !OvertimePay
            lstItem.SubItems(6) = !AwardTicket
            lstItem.SubItems(7) = !FineTicket
            lstItem.SubItems(8) = !pension
            lstItem.SubItems(9) = !wTax 'Change w/tax, results in error!!!!!!
            lstItem.SubItems(10) = !OtherDeductions
            lstItem.SubItems(11) = !OtherEarnings
            lstItem.SubItems(12) = !Loans
            lstItem.SubItems(13) = !TotalDeductions
            lstItem.SubItems(14) = !Medical
            lstItem.SubItems(15) = !Housing
            lstItem.SubItems(16) = !Transport
            lstItem.SubItems(17) = !Furniture
            lstItem.SubItems(18) = !Feeding
            lstItem.SubItems(19) = !Miscellaneous
            lstItem.SubItems(20) = !NetPay
            lstItem.SubItems(21) = !RemainingBalance
            lstItem.SubItems(22) = !TotalPaid
            lstItem.SubItems(23) = !LoanCollected
            lstItem.SubItems(24) = !MonthlyDeduction
            
            .MoveNext
        End With
    Loop
End If
End Sub

Private Sub Command1_Click()

Call Init_Data
End Sub

[AndreRet]

Did this solve your problem?

[styleest]

Hi friend, i just got online and saw ur comment, i'm trying to add it to my code now and see if it solves the problem

[AndreRet]

No problem, enjoy:)

[styleest]

its didnt solve the problem, instead, it kips duplicating all the former records on every month. I'm going to a cafe with a fast network right away to mail you my full project.

[AndreRet]

Cool, I'll wait for it. It seems that the problem now lies in the report side of showing the records correctly. When loading it to the listview, no problem.:)

[styleest]

I'm so happy. you wont believe this, i tried and tried to attach it at the cafe yet no success. i now decided to still leave thesame old code i started with but i removed the slash from the w/Tax and guess what, it started working. I think the '/" has been the source of problem all this while. I'm so grateful and i'll mark it as solved and also put in sometin for the reputation stuff

[AndreRet]

You're the man, thanks. Shows you, perseverance makes you better.

Happy coding:)

[styleest]

Thanks so much, perseverance is really good but if not you that pointed out the '/' in the w/tax, it wouldnt be solved by now. You solved it. I'm really grateful, anytime my internet works fine, i'll upload the full project for your perussal.

Thanks again