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
Related
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.
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
I have a form and want to display a message when there are no records. The SQL in the following code displays no records (Null) (as it should at present). The function does not work as I wish. It neither returns a number nor displays the message. If I put the function in a form that does have records, it counts them accurately.
Public Function NumRecs() As Integer
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT tblClient.ClientName, tblInvoices.SentToPayer, [Adjustment]+[MyFee]+[DBSFee] AS TotFees, tblClient.ClientID, tblDisclosure.ApplicantForenames, tblDisclosure.AppEmail " & _
"FROM ((tblInvoiceDetails INNER JOIN tblDisclosure ON tblInvoiceDetails.DiscLookup = tblDisclosure.ID) INNER JOIN tblInvoices ON tblInvoiceDetails.InvoiceLookup = tblInvoices.ID) INNER JOIN ((tblOfficerDetails INNER JOIN tblOfficers ON tblOfficerDetails.OfficerLookup = tblOfficers.ID) INNER JOIN tblClient ON tblOfficerDetails.ClientLookup = tblClient.ClientID) ON tblInvoices.AppLookup = tblClient.ClientID " & _
"WHERE (((tblInvoices.DatePaid) Is Null)) ")
If Not rs.BOF And Not rs.EOF Then
NumRecs = Me.Recordset.RecordCount
Else
DisplayMessage ("No records.")
NumRecs = 0
End If
rs.Close
Set rs = Nothing
End Function
"I have a form and want to display a message when there are no records."
You can accomplish that task without opening another DAO.Recordset. Just use RecordsetClone, which already exists.
Private Sub Form_Load()
Dim lngRowCount As Long
lngRowCount = 0
With Me.RecordsetClone
If Not (.BOF And .EOF) Then
.MoveLast
lngRowCount = .RecordCount
End If
End With
MsgBox lngRowCount & " records"
End Sub
Whenever I need a record count in DAO I always MoveLast and then MoveFirst however
Dim db as DAO.Database
Dim rst as DAO.Recordset
Dim strSQL as string
strSQL = "" ' your query here
Set db=CurrentDB()
Set rst=db.OpenRecordset(stSQL,dbOpenDynaSet)
With rst
If NOT (.EOF and .BOF) Then ' There are records to be had
Dim iRecCount as Integer
.MoveLast: .MoveFirst
' DAO typically requires the all records before the count
' count is correct
iRecCount = .RecordCount
Else ' There are NOT records to be had
' ADD YOUR MESSAGE HERE FOR NO RECORDS.
End If
.Close
End with
Set rst=nothing
Set db=nothing
Optionally I build up my Queries external to VBA and add parameters. This why I know my query is producing the results I expect. Then you can reference your query as an object of QueryDefs of CurrentDB() object. Then address you parameters as a property of QueryDef.
The following is a great read from Allen Browne on Recordsets.
http://allenbrowne.com/ser-29.html
All you really need is:
Public Function NumRecs() As Integer
Dim rs As DAO.Recordset
Set rs = Me.RecordsetClone
If rs.RecordCount = 0 Then
DisplayMessage ("No records.")
Else
rs.MoveLast
NumRecs = rs.RecordCount
End If
rs.Close
Set rs = Nothing
End Function
In order to get the recordcount with DAO, you need to MoveLast. Also, try changing the 'EOF' check (see below):
Public Function NumRecs() As Integer
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL as String
strSQL = "SELECT tblClient.ClientName, tblInvoices.SentToPayer, [Adjustment]+[MyFee]+[DBSFee] AS TotFees, tblClient.ClientID, tblDisclosure.ApplicantForenames, tblDisclosure.AppEmail " & _
"FROM ((tblInvoiceDetails INNER JOIN tblDisclosure ON tblInvoiceDetails.DiscLookup = tblDisclosure.ID) INNER JOIN tblInvoices ON tblInvoiceDetails.InvoiceLookup = tblInvoices.ID) INNER JOIN ((tblOfficerDetails INNER JOIN tblOfficers ON tblOfficerDetails.OfficerLookup = tblOfficers.ID) INNER JOIN tblClient ON tblOfficerDetails.ClientLookup = tblClient.ClientID) ON tblInvoices.AppLookup = tblClient.ClientID " & _
"WHERE (((tblInvoices.DatePaid) Is Null))"
Set dbs = CurrentDB
Set rs = dbs.OpenRecordset(strSQL)
If Not rs.EOF Then
rs.MoveLast ' ADD THIS LINE
NumRecs = rs.RecordCount
Else
DisplayMessage ("No records.")
NumRecs = 0
End If
rs.Close
Set rs = Nothing
dbs.Close
Set dbs = Nothing
End Function`
I'm trying to generate a bill by route, so I've broken it down by customers belonging to a specific route, and then for each customer totaling their weekly rates to compile a monthly rate.
The problem is, even opening a recordset with a SELECT * IN [table] returns nothing, so there must be some glaring error. Here's my code, I'd be very appreciative if someone could set me straight.
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim rs3 As DAO.Recordset
Dim custNo As Integer
Dim month_total_v As Integer
Dim weekTotal As Integer
Dim weekStart As Date
Dim sql As String
'sql = "SELECT cust_no FROM Roster WHERE route = Forms![routeBill]![route]"
Set rs = CurrentDb.OpenRecordset("SELECT CUST_NO FROM Roster WHERE ROUTE = 'Forms![routeBill]![route]'")
month_total_v = 0
MsgBox ("Boop.")
If Not (rs.EOF) Then
rs.MoveFirst
Do Until rs.EOF = True
MsgBox ("Boop.")
custNo = rs!CUST_NO
Set rs2 = CurrentDb.OpenRecordset("SELECT wk_rate, wk_strt_dt FROM Roster WHERE wk_strt_dt >= Forms![routeBill]![Text53] AND wk_strt_dt <= Forms![routeBill]![Text4] AND cust_no = custNo")
If Not (rs2.EOF And rs2.BOF) Then
rs2.MoveFirst
Do Until rs2.EOF = True
MsgBox "Boop."
weekStart = WK_STRT_DT
month_total_v = month_total_v + rs2!WK_RATE
Set rs3 = CurrentDb.OpenRecordset("SELECT * FROM monthTotal where cust_no = custNo and billMonth=month(weekStart) and billYear=year(weekStart)") 'specify date ranges to pick from to shorten query
If rs3.EOF Then
sql = "INSERT INTO monthTotal (cust_no, month_total, billMonth, billYear) VALUES (custNo, month_total_v, month(weekStart), year(weekStart))" 'Append, record does not exist
DoCmd.RunSQL sql
Else
sql = "UPDATE monthTotal SET month_total = month_total_v WHERE cust_no = custNo AND billMonth = month(weekStart) AND billYear = year(weekStart)" 'Update, record exists
DoCmd.RunSQL sql
End If
rs2.MoveNext
Loop
Else
'pass
End If
rs.MoveNext
Loop
End If
This query will not return any records when none of the stored ROUTE values contain the literal text, 'Forms![routeBill]![route]' ...
SELECT CUST_NO FROM Roster WHERE ROUTE = 'Forms![routeBill]![route]'
Elsewhere you have a WHERE clause which includes AND cust_no = custNo. But, since custNo is a VBA variable, the db engine doesn't know anything about it and will interpret it to be the name of a parameter for which you haven't supplied a value.
You can avoid those types of problems by using a parameter query in a DAO.QueryDef. Then supply the parameter values (from form controls, VBA variables, whatever ...) and use the QueryDef.OpenRecordset method to load your recordset.
Here is a simple example ...
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strSelect As String
strSelect = "SELECT CUST_NO FROM Roster WHERE ROUTE = [which_route]"
Set db = CurrentDb
Set qdf = db.CreateQueryDef(vbNullString, strSelect)
qdf.Parameters("which_route").Value = Forms![routeBill]![route]
Set rs = qdf.OpenRecordset
With rs
If .BOF And .EOF Then
MsgBox "no matches found"
Else
.MoveLast
MsgBox .RecordCount & " matches"
End If
.Close
End With
Note the parameter query technique avoids the need to add quotes around text values (and then also cope with text values which may include quotes within them) and format Date/Time values and enclose them within # delimiters.
The problem is here:
FROM Roster WHERE wk_strt_dt >= Forms![routeBill]![Text53] AND wk
You should outquote Forms![routeBill]![Text53]:
FROM Roster WHERE wk_strt_dt >= " & Forms![routeBill]![Text53] & " AND wk
You also need to get the dates right:
WHERE wk_strt_dt >= #" & Format(Forms![routeBill]![Text53], "yyyy\/mm\/dd") & "# AND wk_strt_dt ... etc
I'm creating a table in VBA within a loop and when I run the code a table is created.
But the next time I run it, an error comes up telling me that the table exists and the remainder of the code is not executed.
How can I have it overwrite the existing table (from the previous run)?
Here is my code:
Option Compare Database
Public Function createTables()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim rst As DAO.Recordset
Dim fld As DAO.Field
Dim strSQL As String
strSQL = "Select SKUS from SKUS"
Set db = CurrentDb()
Set rst = db.OpenRecordset(strSQL)
Set fld = rst.Fields("SKUS")
'MsgBox fld.Value
rst.MoveFirst
Do While Not rst.EOF
Set tdf = db.CreateTableDef(fld.Value)
Set fld = tdf.CreateField("SKUS", dbText, 30)
tdf.Fields.Append fld
Set fld = tdf.CreateField("Count", dbInteger)
tdf.Fields.Append fld
db.TableDefs.Append tdf
rst.MoveNext
Loop
End Function
Can anyone help me out please?
Thanks!
I would simply delete the table before attempting to recreate it:
db.TableDefs.Delete fld.Value
You can check if the table exists with the following function.
Public Function TableExists(TabName As String) As Boolean
Dim db As DAO.Database
Dim Sdummy As String
Set db = CurrentDb()
On Error Resume Next
Sdummy = db.TableDefs(TabName).Name
TableExists = (Err.Number = 0)
End Function
If the function returns true, then issue following sql statement:
DROP TABLE SKUS
The usual method is to test then delete temp table, requiring more code and recordkeeping for calling procedures that run multiple maketables.
Here is a procedure that is all inclusive, gleaning the source table name from maketable, then deleting before recreating. Also returns number of new records.
Public Function fcnMakeTableForce(strMTQuery As String) As Integer
On Error GoTo ErrorExit
'Runs maketable, deleting the resulting temp table contained in the query (if it
'exists) beforehand. Also returns the number of records in new temp table
Dim dbs As Database
Dim strSQL As String
Set dbs = CurrentDb
'Get SQL from MakeTable
strSQL = dbs.QueryDefs(strMTQuery).sql
'Get target table from SQL:
intINTOPos = InStr(strSQL, "INTO [") + 5
intFROMPos = InStr(strSQL, "FROM [") - 3
strTargetTable = Mid(strSQL, intINTOPos + 1, intFROMPos - intINTOPos - 1)
'Clear target table if it exists
If (DCount("*", "MSysObjects", "[Name] = """ & strTargetTable & """")) > 0 Then
CurrentDb.TableDefs.Delete (strTargetTable)
End If
dbs.Execute strMTQuery
intRecordsAdded = DCount("*", strTargetTable)
fcnMakeTableForce = intRecordsAdded
NormalExit:
Exit Function
ErrorExit:
MsgBox "Error: " & Err.Description & vbCr & vbCr & "in Function: fcnMakeTableForce"
Resume NormalExit
End Function