Still the same Error:...
and the qmimi_shitj also ...Code:strSQL = "SELECT qmimi_shitjes FROM tbdArtikujt"
rs.Open strSQL, db, adOpenStatic, adLockOptimistic
but nothing works :(
Printable View
Still the same Error:...
and the qmimi_shitj also ...Code:strSQL = "SELECT qmimi_shitjes FROM tbdArtikujt"
rs.Open strSQL, db, adOpenStatic, adLockOptimistic
but nothing works :(
So, let's get this clear, you've changed the code so it now reads:
and you're still getting "the same Error ", i.e. error '3001', on the 'RS.Open' statement ?Code:Set RS = New ADODB.RecordSet
strSQL = "SELECT qmimi_shitjes FROM tbdArtikujt"
RS.Open strSQL, db, adOpenStatic, adLockOptimistic
yes sir i still getting an error .. but it's a different message and different number as in the picture below
Attachment 101505Attachment 101507
and also i have already tried qmimi_shitj not shitjes as u wrote !
The error message indicates that the connection to the Database is not active.Go back to Post #34 and read this bit again:
So far we've managed to get the Table and the Column name correct all we need now is the Database Connection. I used 'db' as the Database connection, yours is 'strConek'. What do you think you should change ?Quote:
where: 'Table' is the name of the table containing the Price, 'Price' is the column name representing the Price and 'db' is an open connection to the DataBase. Assumes that 'Price' is a Currency Type in the Table.
i have changed the db , but still getting error ... :(
Attachment 101513Attachment 101515
Reread Posts #34 and #65
couldn't fix it :( ... nothing works :(
Doogle's code in #25 shows opening a recordset that works.
Try using that as a basis for what you are doing here.
Doogle .. i end up with this code .. can you please help me a little ..
Code:
Private Sub cmdChangePrice_Click()
Call dbconek
With ar
Dim curDelta As Currency
Dim rs As ADODB.Recordset
If txtDeltaPrice.Text <> "" Then
If IsNumeric(txtDeltaPrice.Text) Then
curDelta = CCur(txtDeltaPrice.Text)
Set rs = New ADODB.Recordset
criteria = "Select *From tblArtikujt Where qmimi_shitjes='" & frmArtLista.txtDeltaPrice & "'"
rs.Open criteria, strConek, 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
welshman .. dude i am trying to do what he says but i can't figure out .. it's very hard to do it my self , at the same time i keep trying to learn something and to figure out what is this and what is that for ...
anyway i think i am getting closer :))
i just need a little push in here :D
thanks for the replay
You dont need the 'with ar', its a shortcut when you're using properties of ar repeatedly.
Also you might need to declare criteria.
Other than that it looks like it should do what you want.
i did like this one ...
as this code to delete a db
Code: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 "The article was deleted successfully.", vbInformation, "Fshirja!"
.Close
End With
lv.Refresh
End If
End If
lv.ListItems.Remove (lv.SelectedItem.Index)
End Sub
man please
You still don't seem to have got the hang of telling us what the problem actually is and where it's happening.
What is the code in Post#74 meant to do, what is the error message and on what line is it happening?
this is the code i end up with to change the prices but it's not working
how i end up with this code ...Code:
Private Sub cmdChangePrice_Click()
Call dbconek
With ar
Dim curDelta As Currency
Dim rs As ADODB.Recordset
If txtDeltaPrice.Text <> "" Then
If IsNumeric(txtDeltaPrice.Text) Then
curDelta = CCur(txtDeltaPrice.Text)
Set rs = New ADODB.Recordset
criteria = "Select *From tblArtikujt Where qmimi_shitjes='" & frmArtLista.txtDeltaPrice & "'"
rs.Open criteria, strConek, 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
i was looking on this one and did almost the same as it is mix with your code
Code: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 "The article was deleted successfully.", vbInformation, "Fshirja!"
.Close
End With
lv.Refresh
End If
End If
lv.ListItems.Remove (lv.SelectedItem.Index)
End Sub
this is your code but can't make it working ..!
Code:Private Sub cmdChangePrice_Click()
Dim strConek As String
Dim curDelta As Currency
Dim rs As ADODB.Recordset
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, dbconek, 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
errors are still the same as usual.
Attachment 101603Attachment 101605
Please post the code for subroutine dbconek
do you mean this
Code: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"
It looks as if your Database Connections is named 'db' so that's what you have to use.
Code: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
:( man still have error !! :(
Attachment 101657Attachment 101659
man this is the hall frm code
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
The failing code is
yet in the code you posted it'sCode:rs.Open strConek, db, adOpenStatic, adLockOptimistic
Since the connection you open in this Form is named 'con' perhaps you should be using thatCode:rs.Open strConek, dbase, adOpenStatic, adLockOptimistic
Code:rs.Open strConek, con, adOpenStatic, adLockOptimistic
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..... :)))))))
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 !!
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 :)
hello ...
new 3 errors in the code....
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
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:
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:Code:Public Function FileExists(ByRef sFile As String) As Boolean
On Error Resume Next
FileExists = (GetAttr(sFile) And vbDirectory) <> vbDirectory
End Function
BTW, it would be best to always pass a fully-qualified path to that function.Code: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
hey man thanks so much ... this fixed the error :))
thank you
this is another error ... please help :) thanks ;)
the error is .. that when i try to relogin with another aco**** when i am already loged in ... it seems like program confused