vb6-how to add progress bar on sql query (mysql) - mysql

I have the following code in a form which hangs up the form whenever the query is still executing:
Public Function OpenRS(strSql As String) As ADODB.Recordset
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.CursorType = adOpenDynamic
If IsNull(Cn) = False Then
rs.Open strSql, Cn, adOpenKeyset, adLockPessimistic ', adAsyncExecute
End If
Set OpenRS = rs
End Function
Tried adding adAsyncExecute but the form closes.
Dim RSC As ADODB.Recordset
Set RSC = Nothing
Set RSC = Cn.Execute("CALL SP_Rank_by_Company('" & MyDate1 & "','" & MyDate2 & "','DELETE')", , adAsyncExecute)
While Cn.State = 4
If frmLoadingReports.picLoading.Width = 5320 Then
frmLoadingReports.picLoading.Width = 0
Else
frmLoadingReports.picLoading.Width = frmLoadingReports.picLoading.Width + 100
End If
'count total records
'get the current number of records processed
DoEvents
Wend
How can I add a progress bar to it?
Thanks!

MySQL doesn't tell you how close to finished a query is, it can only tell you how long it's been running or what's impeding progress, as in what other queries are blocking it.
If you have a really long-running query you need to guess how long it will take if you want to compute an ETA.

Related

MoveFirst in VBScript does not work with a query on a query? [duplicate]

This question already has answers here:
ASP 3.0 Declare ADO Constants w/out Including ADOVBS.inc
(3 answers)
Closed 12 months ago.
I have a piece of VBScript that queries an MS Access database. When the recordset query is on a table, I can go through my recordset and do a rs.MoveFirst to go back to the beginning. But when the recordset query is on a query, rs.MoveFirst fails with the error "Operation is not supported for this type of object" Code: 800004005.
Is this a known limitation? Can I get get around it by opening the recordset in a different way?
I have tried rs.Open like many examples online, but rs.Open strQuery, Cn, adOpenDynamic, adLockPessimistic, adCmdText fails with "Arguments are of the wront type, are out of acceptable range, or are in conflict with one another."
This code works because MyTable is a table:
Set rs = CreateObject("ADODB.Recordset")
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\MyAccessDB.accdb;Mode=Read;"
connection.Open strConnection
Set rs = connection.Execute("SELECT * FROM MyTable")
MsgBox(rs.fields(1))
rs.MoveNext
rs.MoveFirst
MsgBox(rs.fields(1))
This code fails because MyQuery is a query in the database
Set rs = CreateObject("ADODB.Recordset")
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\MyAccessDB.accdb;Mode=Read;"
connection.Open strConnection
Set rs = connection.Execute("SELECT * FROM MyQuery")
MsgBox(rs.fields(1))
rs.MoveNext
rs.MoveFirst
MsgBox(rs.fields(1))
Using rs.Open and defining the constants does not work. This shows the same error "Operation is not supported for this type of object" on the rs.movefirst command.
const adOpenDynamic = 2
const adLockPessimistic = 2
const adCmdText = 1
Set connection = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\MyAccessDB.accdb;Mode=Read;"
connection.Open strConnection
strsql = "SELECT * FROM MyQuery"
rs.Open strsql, connection, adOpenDynamic, adLockPessimistic, adCmdText
Do While Not rs.EOF
msgbox(rs.fields(1))
rs.movenext
msgbox(rs.fields(1))
rs.movefirst
msgbox(rs.fields(1))
Loop
There is a far easier way to deal with this problem and that is to negate ADODB.Recordset entirely and not have to worry about cursor and locking support. It's worth mentioning this will only work for reading the data.
Use GetRows() to retrieve a two-dimensional Array and use that to navigate the data.
Dim strConnection, connection, rs, data
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\MyAccessDB.accdb;Mode=Read;"
Call connection.Open(strConnection)
Set rs = connection.Execute("SELECT * FROM MyTable")
If Not rs.EOF Then data = rs.GetRows()
'Release recordset as it's no longer needed.
Call rs.Close()
Set rs = Nothing
Dim row, rows
Const fld_field1 = 1
If IsArray(data) Then
rows = UBound(data, 2) 'Number of rows
row = 0
Call MsgBox(data(fld_field1, row) 'Second column of First Row
row = 1
Call MsgBox(data(fld_field1, row) 'Second column of Second Row
row = 0
Call MsgBox(data(fld_field1, row) 'Second column of First Row
'If you want to loop the data
For row = 0 To rows
Call MsgBox(data(1, row) 'Second Column of N Row
Next
End If
This will work.
You don't need to declare const, variables, whatelse.
You just need to set a reference to ADODB, in your case a reference to Microsoft Activex Data Objects 2.8 Library.
There is no reason this would not work.
Set Connection = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Dim strConnection
Dim sql
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\MyAccessDB.accdb;Mode=Read;"
Connection.Open strConnection
sql = "SELECT * FROM MyQuery"
rs.Open sql, Connection, adOpenStatic, adLockReadOnly, adCmdText
MsgBox (rs.Fields(1))
rs.MoveNext
MsgBox (rs.Fields(1))
rs.MoveFirst
MsgBox (rs.Fields(1))
rs.Close
Set rs = Nothing
Connection.Close
Set Connection = Nothing
EDIT: I overlooked the fact you wrote "piece of vbscript". If you are using this code in a vbs file, then you need to declare the constants
Const adOpenStatic = 3
Const adLockReadOnly = 1
Const adCmdText = &H0001

Why can I run a Query via the query editor but running through vba fails?

I am trying to retrieve records from a table in access using VBA. So far I have this simple function:
Private Function GNCN() As String
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim cm As ADODB.Command
Dim strSQL As String
Dim intYD As Integer
Set cn = CurrentProject.Connection
'cn.CursorLocation = adUseClient
rs.CursorLocation = adUseClient
rs.LockType = adLockReadOnly
intYD = 16
strSQL = "SELECT DCN FROM tblDCD WHERE (DCN like '" & intYD & "*')"
Set rs = cn.Execute(strSQL)
Debug.Print rs.RecordCount
Set rs = Nothing
Set cm = Nothing
Set cn = Nothing
End Function
When I run this, I don't get any records returned.
However if I take the SQL query:
SELECT DCN FROM tblDCD WHERE (DCN like '16*')
and run this within Access' query builder, I get around 912 records returned, so I know I am able to retrieve the records and that the query itself appears to be correct.
The table is simple data which consists of string values such as (in the DCN column):
"13000"
"17001"
"16003"
Around 38000 in total so I shaln't print them all here...
Does anyone know why this will work via the query builder but not via VBA?
Thanks
Appear to be mixing DAO and ADODB. Consider:
Private Function GNCN() As String
Dim rs As DAO.Recordset
Dim strSQL As String
Dim intYD As Integer
intYD = 13
strSQL = "SELECT DCN FROM Rates WHERE DCN like '" & intYD & "*';"
Set rs = CurrentDb.OpenRecordset(strSQL)
rs.MoveLast
Debug.Print rs.RecordCount
Set rs = Nothing
End Function

How to loop in Visual Basic 6, my FOR loop is not working

Hello everyone!
I,m trying to use FOR loop in my vb6 project. In the subject there are two recordsets. First recordset find the record in MS Access database table and get some values then second recordset use these values to update in another table.
When I compile there is no error, but in the table no value update. Moreover this loop work only one time I mean it is not looping. What is wrong? Please Help!
Thanks
Sub UpdatePreQty()
Dim rsTmp As New ADODB.Recordset
Dim rsStock As New ADODB.Recordset
Dim tmpICODE As String
Dim tmpBCODE As String
Dim tmpQty As String
For I = 1 To Val(txtTmpItemCount.Text)
Dim strsql As String '-----Write this line only once on a form
strsql = "SELECT * FROM [bill_details] WHERE [bill_sno] =" & sno
If rsTmp.State = adStateOpen Then rsTmp.Close
rsTmp.Open strsql, cn, adOpenStatic, adLockOptimistic
tmpICODE = rsTmp("prod_sno")
tmpBCODE = rsTmp("Batch")
tmpQty = rsTmp("qty")
If rsStock.State = adStateOpen Then rsStock.Close
rsStock.Open "SELECT * FROM Batch where BCODE='" & tmpBCODE & "' and ICODE ='" & tmpICODE & "' and [ccode]='" & Ccode & "'", cn, adOpenDynamic, adLockOptimistic
rsStock("OUT") = (Val(rsStock("OUT")) - tmpQty)
rsStock("CBAL") = Val(rsStock("OBAL")) + Val(rsStock("IN")) - Val(rsStock("OUT")) '
rsStock.Update
Next
MsgBox "Previous stock update"
If rsStock.State = adStateOpen Then rsStock.Close
If rsTmp.State = adStateOpen Then rsTmp.Close
End Sub
Solved with change FOR LOOP to DO WHILE
Do While Not rsTmp.EOF
Loop
Thanks to all

"LIKE" operator works in MS Access, but not ADO

I'm trying to filter records using "Like" with asterisks, it works when using Access 2010 returning many records. I'm stumped why it returns nothing when used with ADO. The code includes multiple tables and columns so to troubleshoot I made a simple query. Here's the code:
strsql = "SELECT tproducts.Prod_Name FROM tproducts " _
& " WHERE tproducts.Prod_Name Like " & Chr(34) & "SO*" & Chr(34)
Set cn = New ADODB.Connection
cn = connString
cn.Open
Set rs = New ADODB.Recordset
rs.Open strsql, cn, adOpenStatic, adLockOptimistic
' test here
iRecCount = rs.RecordCount
rs.MoveFirst
Recordcount returns -1.
When "Like" is replaced by "equals" it returns correct record so I'm sure it's able to connect to the database, for example:
strsql = "SELECT tproducts.Prod_Name FROM tproducts " _
& " WHERE tproducts.Prod_Name = " & Chr(34) & "SONY Vaio SVD13213CXB" & Chr(34)
Is there a special way to use the Like operator in ADO?
What other ways can I filter to give results same as using "Like"? For example, to find all "SVD" products?
In MS Access, the wildcard is nearly always *, outside of MS Access it is nearly always %, so
str = "SELECT tproducts.Prod_Name FROM tproducts) " _
& " WHERE tproducts.Prod_Name Like ""SO%"""
However, I strongly recommend that you move to parameters to avoid a number of serious problems.
DAO is by far the better choice for ACE / Jet ( rough example Loop table rows in Access, with or without use of Private Const )
You cannot count on RecordCount. It often returns -1 even if rows were returned. It will only return actual count if you are using a client side cursor.
Instead, use rs.EOF to check for end of recordset. Try something like the following:
Set cn = New ADODB.Connection
cn = connString
cn.Open
Set rs = New ADODB.Recordset
rs.Open strsql, cn, adOpenStatic, adLockOptimistic
' very innefficient way to find the record count, but gives you the idea. If you just care about record count use "COUNT(*)" in your query
do while not rs.eof
iRecCount = iRecCount + 1
rs.MoveNext
loop
dim strSQL as string
dim RC as variant
dim rs as adodb.recordset
set rs = new adodb.recordset
strSQL = "Select * from sometable"
rs.open strSQL,currentproject.connection,
adopenDynamic, adlockOptimistic
RC = rs.recordcount
rs.close
set rs = nothing
is a problem but..
dim strSQL as string
dim RC as variant
dim rs as adodb.recordset
set rs = new adodb.recordset
strSQL = "Select * from sometable"
rs.Open strSQL, CurrentProject.Connection,
adOpenKeyset, adLockReadOnly
RC = rs.recordcount
rs.close
set rs = nothing
will return the correct record count.

Ms Access VB6 update recordset instead of duplication

Hi i am using vb6 ms access backend, instead of updating a record it duplicates and creates a new entry. my table does not use primary key due to the relationship with other tables. How can i make it update a record and not duplicate here is my code
Private Sub cmdSave_Click()
With Connect.rsitem
.Open , , adOpenDynamic, adLockOptimistic
If EditItem = False Then .AddNew
!itemno = txtItemNo.Text
!desc1 = txtDesc1.Text
!desc2 = txtDesc2.Text
!onhandqty = txtOnhandQty.Text
!unitprice = txtUnitPrice.Text
!Size = txtSize.Text
!upc = txtupc.Text
!Ordercost = txtOrderCost.Text
.Update
.Close
End sub
Do select query first ..
Dim rs As DAO.Recordset
rs.Open "SELECT * FROM mytable WHERE itemno = '" & txtItemNo.Text & "'"
If Not rs.BOF and Not rs.EOF then
'save the record ......
End If
If rs.State = adStateOpen Then rs.Close
Set rs = Nothing