I receive data from a barcode scanner like the below. I need to populate the BoxID (type = integer) from the ID field.
This is the desired result - the ID uniquely identifies the box:
Assuming that data is consistent, consider:
Sub SetBoxID()
Dim rs As DAO.Recordset, intID As Integer
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Table1 ORDER BY ID")
While Not rs.EOF
If rs!Type = "Box" Then
intID = rs!ID
ElseIf rs!Type = "Desp" Then
rs.Edit
rs!BoxID = intID
rs.Update
End If
rs.MoveNext
Wend
End Sub
Related
Could use a little help. Previously I have been using IIF statements to get this output but there are limitations to IIF and now am looking for a function (In MS Access) to meet the requirement.
Challenge: Need to search a row for a criteria (e.g. Title 00\Question..), if/when a match is found it returns the column name using a function withing a query (e.g. FieldCategorization(Title 00\Question). Click on links below to see table and desired output
Microsoft access table:
Desired output from query:
What I have so far searches the entire table, it doesn't seach a row-per-row basis:
Public Function FieldCategorization(TblName As String, Criteria As Long) As String
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset(TblName)
Dim fld As DAO.Field
' MyValue = 224803 ' T00 = Title 00\Question\First Name Text
' MyValue = 224814 ' AB00 = Abbreviation 00
MyValue = Criteria
'MsgBox "TblName: " & TblName & vbCrLf & "Criteria: " & Criteria
rs.MoveFirst
' Move through each row in the recordset
'Do While Not rs.EOF
For Each fld In rs.Fields
If fld = MyValue Then
FieldCategorization = fld.Name
End If
Next fld
rs.MoveNext
'Loop
End Function
Just did something similar today. The example below is super simplified, but I think it has all the elements you're looking for.
dim fld as fields
dim rst, rstW as recordset
MyValue = "Title 00\Question"
Set dbs = currentdB
Set rst = dbs.openrecordset ("table1")
Set rstW = dbs.openrecordset ("table2")
rst.movefirst
Do while not rst.eof
for each fld in rst.fields
if me(fld.name) = MyValue then
rstW.addnew
rstW!Title00 = fld.name
rstW.update
end if
next fld
rst.movenext
Loop
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 have a module with a procedure inside that looks like this:
Public Sub OpenRecordset()
Dim qdf As QueryDef
Set qdf = CurrentDb.QueryDefs("QOff2")
qdf.Parameters(0).Value = [Forms]![Form]![Text10]
Dim db As Database
Dim rs As Recordset
Dim StrBusinesses As String
Set rs = qdf.OpenRecordset
If rs.EOF And rs.BOF Then
MsgBox ("No businesses exist for this Customer")
Exit Sub
Else
rs.MoveFirst
End If
StrBusinesses = ""
Do While Not rs.EOF
StrBusinesses = StrBusinesses & rs!Fnam & ", "
rs.MoveNext
Loop
rs.Close
StrBusinesses = Left(StrBusinesses, Len(StrBusinesses) - 2)
Forms!Form.Badge = StrBusinesses
Set rs = Nothing
End Sub
I am trying to get this module to input the query results into a textbox (forms!form.badge), but I can't seem to get it to do it like my 5 other dlookup functions. When I open up the module and push the green play button, it shows up on the correct textbox but also shows up on the other records as well. It also doesn't show up automatically, nor does it update as you enter in the parameters. Isn't a module supposed to help autofil numerous variables into a text box in place of dlookup for multiple values?
No. If Forms!Form!Badge is an unbound textbox, a value assigned to it will be shown identically for all records.
To individualize, you will need a lookup function which takes the ID or other unique value of the record as parameter(add to textbox):
=LookupBadges([Forms]![Form]![Text10])
Public Function LookupBadges(ByVal Value As Variant) As Variant
Dim db As Database
Dim qd As QueryDef
Dim rs As Recordset
Dim Businesses As String
Set db = CurrentDb
Set qd = db.QueryDefs("QOff2")
qd.Parameters(0).Value = Nz(Value)
Set rs = qd.OpenRecordset
If rs.RecordCount > 0 Then
rs.MoveFirst
Do While Not rs.EOF
Businesses = Businesses & rs!Fnam.Value & ", "
rs.MoveNext
Loop
End If
rs.Close
Businesses = Left(Businesses, Len(Businesses) - 2)
LookupBadges = Businesses
Set rs = Nothing
Set qd = Nothing
Set db = Nothing
End Function
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