code error 09 in vb 6 accounting system

[nawar]

Please post the code for subroutine dbconek

I dont know what does that mean

[nawar]

do you mean this

db.Open "PROVIDER=MSDataShape;Data PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Data\dbase.db;" & ";Persist Security Info=False;Jet OLEDB:Database Password=cc03bn01"

[Doogle]

It looks as if your Database Connections is named 'db' so that's what you have to use.

Private Sub cmdChangePrice_Click()
Dim strConek As String
Dim curDelta As Currency
Dim rs As ADODB.Recordset
Call dbconek
If txtDeltaPrice.Text <> "" Then
    If IsNumeric(txtDeltaPrice.Text) Then
        curDelta = CCur(txtDeltaPrice.Text)
        Set rs = New ADODB.Recordset
        strConek = "SELECT qmimi_shitjes FROM tbdArtikujt"
        rs.Open strConek, db, adOpenStatic, adLockOptimistic
        If Not (rs.BOF And rs.EOF) Then
            Do Until rs.EOF
                rs![qmimi_shitjes] = rs![qmimi_shitjes] + (curDelta * rs![qmimi_shitjes] / 100)
                rs.Update
                rs.MoveNext
            Loop
        End If
    Else
        MsgBox "Please enter a numeric percentage value to apply to all the Prices"
    End If
Else
    MsgBox "Change Percentage cannot be blank"
End If
End Sub

[nawar]

man still have error !!

[nawar]

man this is the hall frm code

Dim CURR_COL As Integer
Dim blnEdit As Boolean
Dim lngIndex As Long
Dim autoProd As New ADODB.Recordset
Dim Prod As New ADODB.Recordset
Dim ls As ListItem
Public calther As String
Public con As New ADODB.Connection
Public rs As New ADODB.Recordset
Dim tHt As LVHITTESTINFO
Dim lstid As String

Function dpProd()
Do While Not Prod.EOF
Set ls = lv.ListItems.Add(, , Prod!barkodi, , 1)
ls.SubItems(1) = Prod!pershkrimi
ls.SubItems(2) = Prod!sasia
ls.SubItems(3) = Prod!tvsh
ls.SubItems(4) = Prod!qmimi_shitjes
Prod.MoveNext
Loop
Set Prod = Nothing
End Function



Private Sub cmdChangePrice_Click()
Dim strConek As String
Dim curDelta As Currency
Dim rs As ADODB.Recordset
Call dbconek
If txtDeltaPrice.Text <> "" Then
    If IsNumeric(txtDeltaPrice.Text) Then
        curDelta = CCur(txtDeltaPrice.Text)
        Set rs = New ADODB.Recordset
        strConek = "SELECT qmimi_shitjes FROM tbdArtikujt"
        rs.Open strConek, dbase, adOpenStatic, adLockOptimistic
        If Not (rs.BOF And rs.EOF) Then
            Do Until rs.EOF
                rs![qmimi_shitjes] = rs![qmimi_shitjes] + (curDelta * rs![qmimi_shitjes] / 100)
                rs.Update
                rs.MoveNext
            Loop
        End If
    Else
        MsgBox "Please enter a numeric percentage value to apply to all the Prices"
    End If
Else
    MsgBox "Change Percentage cannot be blank"
End If
End Sub


Private Sub fff_Click()
If lv.ListItems.Count = 0 Then
Exit Sub
Else
If txtbar.Text = "" Then
Exit Sub
Else
Call dbconek
With ar
criteria = "Select *From tblartikujt Where barkodi ='" & txtbar & "'"
.Open criteria, strConek, adOpenStatic, adLockOptimistic
!barkodi = txtbarkodi
!pershkrimi = txtpershkrimi
!furnizuesi = lblsupp
!kategoria = lblcat
!qmimi = txtblerja
!sasia = txtsasia
!tvsh = txtvat
!qmimi_shitjes = txtshitja
.Delete
MsgBox "Artikulli u fshi me sukses.", vbInformation, "Fshirja!"
.Close
End With
lv.Refresh
End If
End If
lv.ListItems.Remove (lv.SelectedItem.Index)
End Sub

Private Sub Form_Load()
Call ListView_FullRowSelect(lv)
lv.ListItems.Clear
Call dbconek
With ar
criteria = "Select *From tblartikujt"
.Open criteria, strConek, 3, 3
Do While Not .EOF
lv.ListItems.Add , , !barkodi, 1, 1
lv.ListItems(lv.ListItems.Count).SubItems(1) = !pershkrimi
lv.ListItems(lv.ListItems.Count).SubItems(2) = !sasia
lv.ListItems(lv.ListItems.Count).SubItems(3) = !tvsh
lv.ListItems(lv.ListItems.Count).SubItems(4) = Format(!qmimi_shitjes, "###,###,##0.00")
.MoveNext
Loop
.Close
End With
con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Data\dbase.db;Persist Security Info=False;Jet OLEDB:Database Password=cc03bn01"
lv.Sorted = True
End Sub

Private Sub Form_Resize()
'lv.Height = Me.Height
'lv.Width = Me.Width
End Sub

Private Sub Form_Unload(Cancel As Integer)
con.Close
End Sub

Private Sub lv_Click()
If lv.ListItems.Count = 0 Then
Exit Sub
Else
txtbar.Text = lv.SelectedItem.Text
End If
End Sub

Private Sub lv_ColumnClick(ByVal ColumnHeader As ComctlLib.ColumnHeader)
If ColumnHeader.Index - 1 <> CURR_COL Then
lv.SortOrder = 0
Else
lv.SortOrder = Abs(lv.SortOrder - 1)
End If
lv.SortKey = ColumnHeader.Index - 1
lv.Sorted = True
CURR_COL = ColumnHeader.Index - 1
End Sub

Private Sub lv_DblClick()
Call mnundrysho_Click
End Sub

Private Sub lv_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then PopupMenu mnumenyja
End Sub

Private Sub mnundrysho_Click()
frmAdd_List.txtbarkodi = lv.SelectedItem.Text
'===========================
Call dbconek
With ar
criteria = "Select *From tblArtikujt Where barkodi='" & frmAdd_List.txtbarkodi & "'"
.Open criteria, strConek, adOpenStatic, adLockOptimistic
If .RecordCount = 1 Then
frmAdd_List.txtpershkrimi = !pershkrimi
frmAdd_List.txtblerja = !qmimi
frmAdd_List.txtvat = !tvsh
frmAdd_List.txtsasia = !sasia
frmAdd_List.txtshitja = !qmimi_shitjes
frmAdd_List.cboCategory.Text = !kategoria
frmAdd_List.cboSupp.Text = !furnizuesi
Else
MsgBox "Shenimi nuk eshte gjetur.", vbInformation, "Gabim!"
Exit Sub
End If
.Close
End With
'======================
frmAdd_List.Caption = "Ndrysho artikullin"
frmAdd_List.txtbarkodi.Enabled = False
frmAdd_List.Show 1
End Sub

Private Sub mnunnn_Click()
frmAdd_List.txtbarkodi = lv.SelectedItem.Text
'===========================
Call dbconek
With ar
criteria = "Select *From tblArtikujt Where barkodi='" & frmAdd_List.txtbarkodi & "'"
.Open criteria, strConek, adOpenStatic, adLockOptimistic
If .RecordCount = 1 Then
frmAdd_List.txtpershkrimi = !pershkrimi
frmAdd_List.txtblerja = !qmimi
frmAdd_List.txtvat = !tvsh
frmAdd_List.txtsasia = !sasia
frmAdd_List.txtshitja = !qmimi_shitjes
frmAdd_List.cboCategory.Text = !kategoria
frmAdd_List.cboSupp.Text = !furnizuesi
Else
MsgBox "Shenimi nuk eshte gjetur.", vbInformation, "Gabim!"
Exit Sub
End If
.Close
End With
'======================
frmAdd_List.Caption = "Ndrysho artikullin"
frmAdd_List.txtbarkodi.Enabled = False
frmAdd_List.Show 1
End Sub


Private Sub mnushto_Click()
frmAdd_List.Caption = "Shto Artikull të ri"
frmAdd_List.Show 1
End Sub
' add by nawar
Private Sub mnushtt_Click()
frmAdd_List.Caption = "Shto Artikull të ri"
frmAdd_List.Show 1
End Sub


Private Sub Text1_Change()

End Sub

Private Sub txtsearch_Change()
If Prod.State = 1 Then Set Prod = Nothing
calther = "SELECT * from [tblArtikujt] where [pershkrimi] like '%" & Trim(txtsearch) & "%'"
Prod.Open calther, con, adOpenKeyset, adLockOptimistic
lv.ListItems.Clear
dpProd
End Sub

Private Sub txtsearchbar_Change()
If Prod.State = 1 Then Set Prod = Nothing
calther = "SELECT * from [tblArtikujt] where [barkodi] like '%" & Trim(txtsearchbar) & "%'"
Prod.Open calther, con, adOpenKeyset, adLockOptimistic
lv.ListItems.Clear
dpProd
End Sub

[Doogle]

The failing code is

rs.Open strConek, db, adOpenStatic, adLockOptimistic

yet in the code you posted it's

rs.Open strConek, dbase, adOpenStatic, adLockOptimistic

Since the connection you open in this Form is named 'con' perhaps you should be using that

rs.Open strConek, con, adOpenStatic, adLockOptimistic

[nawar]

hahahahaha Mr.Doogle ... you are so awesome man !! i Love ya so much .... my best regards to you sir ...

thank you thank you thank you thank you..... ))))))

[nawar]

dude please there is a problem in the script .. when i do +2.0 it do the trick but when i do -2.0 it calculate more than 2.0!!!! i mean when i do a +2.0 on 2000 it make it 2200 for example but when i do -2.0 i make it 1980 ... not 2000 !! and with 1980.67 like that !! i dont want it like that !!

[Doogle]

I can't change the nature of Mathematics!

2% of 2000 is 40, so 2000 + 2% of 2000 = 2040
2% of 2040 is 40.8, so 2040 - 2% of 2040 = 1999.2

What did you expect ? (you may have to go back to School if you expected 2000 )

[nawar]

I can't change the nature of Mathematics!

2% of 2000 is 40, so 2000 + 2% of 2000 = 2040
2% of 2040 is 40.8, so 2040 - 2% of 2040 = 1999.2

What did you expect ? (you may have to go back to School if you expected 2000 )

Hehehe man i just want it to be without the *.45 i want it to be just a simple number

Mmm. If its impossible to make it withiut the *,678 then , can u please tell me how to just add a number to calculate it

Like i write 200 and the prices will get higher with 200 , and -200 all prices go down 200 , can i do that ? How
Thank you

[Doogle]

Like i write 200 and the prices will get higher with 200 , and -200 all prices go down 200 , can i do that ? How
Thank you

You are joking aren't you ?

NewPrice = OldPrice + Value

[nawar]

hello ...
new 3 errors in the code....

Private Sub Command1_Click()
If txtpaguar < txttotal Then
txtpaguar.SetFocus
SendKeys "{home}+{end}"
Exit Sub
Else
For ilst = 1 To frmShitja.lvshitja.ListItems.Count
lstid = frmShitja.lvshitja.ListItems(ilst).Text
lstpershkrimi = frmShitja.lvshitja.ListItems(ilst).SubItems(1)
lstqmimi = frmShitja.lvshitja.ListItems(ilst).SubItems(2)
lstsasia = frmShitja.lvshitja.ListItems(ilst).SubItems(3)
lsttotal = frmShitja.lvshitja.ListItems(ilst).SubItems(4)
'Ruajtja ne raportet e shitjes
'***********************************************************
Set ac = New ADODB.Connection
Set ar = New ADODB.Recordset
Call dbconek
ac.Open strConek
With ar
criteria = "Select *From tblshitja"
.Open criteria, strConek, adOpenStatic, adLockOptimistic
.AddNew
!shitja_nr = frmShitja.lblnumri.Caption
!barkodi = lstid
!pershkrimi = lstpershkrimi
!qmimi = lstqmimi
!sasia = lstsasia
!total = lsttotal
!Data = Format(Now, "mm/dd/yyyy")
!punetori = frmShitja.lblemri.Caption
!arka = frmShitja.lblarka.Caption
!muaji = Format(Now, "mm")
!viti = Format(Now, "yyyy")
.Update
.Close
End With
'Nderrimi i sasive
'***********************************************************
Set ac = New ADODB.Connection
Set ar = New ADODB.Recordset
Call dbconek
ac.Open strConek
With ar
criteria = "Select *From tblArtikujt Where barkodi='" & lstid & "'"
.Open criteria, strConek, adOpenStatic, adLockOptimistic
!sasia = Val(!sasia) - Val(lstsasia)
.Update
.Close
End With
Next
'Printimi ******************************
Open App.Path & "\Raporti.txt" For Output As #1
Printer.FontName = "Courier New"
Printer.FontSize = 9
Print #1, " "
Close #1
Open App.Path & "\Raporti.txt" For Append As #1
Print #1, lblfirma.Caption
Print #1, " "
Print #1, "NIB :  "; lblnib.Caption
Print #1, Format(Now, "dd/mm/yyyy") & "          " & Format(Now, "hh:mm:ss")
Print #1, "Arka :" & lblarka.Caption & "         " & "Paragoni NR :" & frmShitja.lblnumri.Caption
Print #1, " "
Print #1, "........................................"
Print #1, " "
For ii = 1 To frmShitja.lvshitja.ListItems.Count
Print #1, frmShitja.lvshitja.ListItems(ii).SubItems(1)
Print #1, "          " & frmShitja.lvshitja.ListItems(ii).SubItems(2) & "   x   "; frmShitja.lvshitja.ListItems(ii).SubItems(3) & "   =   " & frmShitja.lvshitja.ListItems(ii).SubItems(4)
Next
Print #1, " "
Print #1, "........................................."
Print #1, ""
Dim lngSpace As Long

Print #1, "TOTALI   :  " & Space(lngSpace) & Format(txttotal, "###,##0.00") & " "
Print #1, "PAGUAR  :  " & Space(lngSpace) & Format(txtpaguar, "###,##0.00") & " "
Print #1, "KUSURI   :  " & Space(lngSpace) & Format(txtkusuri, "###,##0.00") & " "

Print #1, " "
Print #1, " "
Print #1, "TVSH është llogaritur në çmim"
Print #1, " "
Print #1, "Ju faleminderit!!"
Print #1, " "
Close #1
If lblprint.Caption = "PO" Then
Shell App.Path & "\prnt_fat.exe", vbHide
End If
'*******End Print*********************************************************
WriteINI App.Path & "\Paragoni.ini", "Numri", "Numri", frmShitja.lblnumri + 1
Dim Arq1 As String
Arq1 = ReadINI(App.Path & "\Paragoni.ini", "Numri", "Numri")
frmShitja.lblnumri.Caption = Arq1
frmShitja.lvshitja.ListItems.Clear
frmShitja.lbltotal.Caption = "0.00"
On Error Resume Next
LCD_Command (LCD_CLR)
frmShitja.MSComm1.Output = txbuff
LCD_Command (LCD_CLR)
frmShitja.MSComm1.Output = txbuff
LCD_Command (NEXT_LINE)
frmShitja.MSComm1.Output = txbuff
txbuff = "> B I G    S T A R <"
frmShitja.MSComm1.Output = txbuff
Unload Me
End If
End Sub

Private Sub Form_Load()
Dim Arq1 As String
Dim Arq2 As String
Dim Arq3 As String
Dim Arq4 As String
Arq1 = ReadINI(App.Path & "\Konfigurimi.ini", "Kompania", "Kompania")
Arq2 = ReadINI(App.Path & "\Konfigurimi.ini", "NIB", "NIB")
Arq3 = ReadINI(App.Path & "\Konfigurimi.ini", "Arka", "Arka")
Arq4 = ReadINI(App.Path & "\Konfigurimi.ini", "Print", "Print")
lblfirma.Caption = Arq1
lblnib.Caption = Arq2
lblarka.Caption = Arq3
lblprint.Caption = Arq4
'***************************
On Error Resume Next
LCD_Command (LCD_CLR)
frmShitja.MSComm1.Output = txbuff
LCD_Command (LCD_CLR)
frmShitja.MSComm1.Output = txbuff
LCD_Command (NEXT_LINE)
frmShitja.MSComm1.Output = txbuff
txbuff = frmShitja.lbltotal.Caption
frmShitja.MSComm1.Output = "TOTAL:  " & txbuff
End Sub

Private Sub txtpaguar_Change()
If txtpaguar.Text = "" Then
txtkusuri.Text = ""
Else
txtkusuri.Text = Format(txtpaguar - CCur(txttotal), "###,###,###0.00")
End If
End Sub

Private Sub txtpaguar_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
'***************************
On Error Resume Next
LCD_Command (LCD_CLR)
frmShitja.MSComm1.Output = txbuff
LCD_Command (LCD_CLR)
frmShitja.MSComm1.Output = txbuff
LCD_Command (NEXT_LINE)
frmShitja.MSComm1.Output = txbuff
txbuff = frmShitja.lbltotal.Caption
frmShitja.MSComm1.Output = "TOTAL:  " & txbuff
Unload Me
End If
End Sub

Private Sub txtpaguar_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Command1_Click
End If
End Sub

[nawar]

[Bonnie West]

Q: What should you do if VB complains that a file cannot be found?

A: You don't attempt to access it, of course!


Q: How can you know whether a file exists or not?

A: You check it with a FileExists function, such as the following:

Public Function FileExists(ByRef sFile As String) As Boolean
    On Error Resume Next
    FileExists = (GetAttr(sFile) And vbDirectory) <> vbDirectory
End Function

Copy that handy function to a BAS module and call it every time you want to make sure a certain file is present before attempting to perform any read operation on it. For example:

If FileExists(App.Path & "\prnt_fat.exe") Then
    Shell App.Path & "\prnt_fat.exe", vbHide
Else
   'Do something here if file cannot be found
End If

BTW, it would be best to always pass a fully-qualified path to that function.

[nawar]

hey man thanks so much ... this fixed the error )
thank you

[nawar]

this is another error ... please help thanks

[nawar]

the error is .. that when i try to relogin with another aco**** when i am already loged in ... it seems like program confused