Just started with Access VBA today and imagine this is a simple fix. The program calculates total guests in each service category. I must be missing something simple.
Public Sub CalculateTotalGuestsForEachService()
'Declare variables
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim intTotalParty As Integer
'Set the current database
Set db = CurrentDb
'Set the recordset
Set rst = db.OpenRecordset("Select Orders.* From Orders Where ServiceID = 1")
'Cycle through the records
Do While Not rst.EOF
intTotalParty = intTotalParty + rst!NoInParty
rst.MoveNext
Loop
'Display total amount
MsgBox "The total is " & intTotalParty
'Close the recordset
rst.Close
Set rst = Nothing
Set db = Nothing
End Sub
If any record has a Null value, apply Nz:
intTotalParty = intTotalParty + Nz(rst!NoInParty.Value, 0)
or, you could let the query sum the values:
'Set the recordset
Set rst = db.OpenRecordset("Select Sum(NoInParty) As TotalParty From Orders Where ServiceID = 1")
If rst.RecordCount = 1 Then
intTotalParty = Nz(rst!TotalParty.Value)
End If
Related
PO_D_Temp contains several fields 2 of which are [InvNo] and [Detail_Line].There will be many rows that belong with same [InvNo]. I would like each [Detail_Line] to begin with 1, 2 etc for each [InvNo]
Example: [InvNo]1 [Detail_Line] 1 [InvNo]1 [Detail_Line] 2 [InvNo]2 [Detail_Line] 1 [InvNo]3 [Detail_Line] 1 ETC!
All I have been able to figure out is a loop that adds an incrementing number to ALL records - not renumbering at each different InvNo.
Here is what I have (I am at kindergarten level, sorry):
Private Sub Command1_Click()
Dim db As Database
Set db = CurrentDb()
Dim rstPO_D_Temp As Recordset
Dim strSQL As String
Dim intI As Integer
Dim DetailNum As Integer
'Open a recordset on all records from the PO_D_Temp table
strSQL = "SELECT * FROM PO_D_Temp"
Set rstPO_D_Temp = db.OpenRecordset(strSQL, dbOpenDynaset)
DetailNum = 0
' If the recordset is empty, exit.
If rstPO_D_Temp.EOF Then Exit Sub
intI = 1
With rstPO_D_Temp
Do Until .EOF
.Edit
![Detail_Line] = DetailNum + intI
.Update
.MoveNext
intI = intI + 1
Loop
End With
rstPO_D_Temp.Close
Set rstPO_D_Temp = Nothing
End Sub
Reset the detail no. for each invoice no.:
Private Sub Command1_Click()
Dim db As DAO.Database
Set db = CurrentDb()
Dim rstPO_D_Temp As DAO.Recordset
Dim strSQL As String
Dim DetailNum As Integer
Dim LastInvoice As Long
'Open a recordset on all records from the PO_D_Temp table
strSQL = "SELECT * FROM PO_D_Temp"
Set rstPO_D_Temp = db.OpenRecordset(strSQL, dbOpenDynaset)
With rstPO_D_Temp
Do Until .EOF
If LastInvoice <> !InvNo.Value Then
DetailNum = 1
LastInvoice = !InvNo.Value
Else
DetailNum = DetailNum + 1
End If
.Edit
![Detail_Line].Value = DetailNum
.Update
.MoveNext
Loop
.Close
End With
Set rstPO_D_Temp = Nothing
End Sub
I have two tables, tb1 and tb2. I would like to copy the entire record from tab1 to tbl2. The tables contain attachment fields so INSERT statement is not suitable. My current approach uses DAO but its only copying the first record. Please see code:
Private Sub InsertRecord_Click()
Dim db As Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim rsAttachment1 As DAO.Recordset2
Dim rsAttachment2 As DAO.Recordset2
Set rs1 = CurrentDb.OpenRecordset("tbl1")
Set rs2 = CurrentDb.OpenRecordset("tbl2")
With rs1
rs2.AddNew
rs2.Fields("ItemNo").Value = rs1.Fields("ItemNo").Value
rs2.Fields("Location").Value = rs1.Fields("Location").Value
rs2.Fields("Owner").Value = rs1.Fields("Owner").Value
rs2.Fields("DateSent").Value = DateTime.Now
Set rsAttachment1 = rs1.Fields("ItemImage").Value
Set rsAttachment2 = rs2.Fields("ItemImage").Value
With rsAttachment1
Do While Not .EOF
rsAttachment2.AddNew
rsAttachment2.Fields("FileData") = .Fields("FileData")
rsAttachment2.Fields("FileName") = .Fields("FileName")
rsAttachment2.Update
rsAttachment1.MoveNext
Loop
End With
rs2.Update
.MoveNext
End With
rs2.Close
Set rs2 = Nothing
'rsAttachment1.Close
Set rsAttachment1 = Nothing
Set rsAttachment2 = Nothing
End Sub
Any other better approach is also welcome.
Use a loop:
While Not rs1.EOF
With rs1
rs2.AddNew
rs2.Fields("ItemNo").Value = rs1.Fields("ItemNo").Value
rs2.Fields("Location").Value = rs1.Fields("Location").Value
rs2.Fields("Owner").Value = rs1.Fields("Owner").Value
rs2.Fields("DateSent").Value = DateTime.Now
Set rsAttachment1 = rs1.Fields("ItemImage").Value
Set rsAttachment2 = rs2.Fields("ItemImage").Value
With rsAttachment1
Do While Not .EOF
rsAttachment2.AddNew
rsAttachment2.Fields("FileData") = .Fields("FileData")
rsAttachment2.Fields("FileName") = .Fields("FileName")
rsAttachment2.Update
rsAttachment1.MoveNext
Loop
End With
rs2.Update
.MoveNext
End With
rs1.MoveNext
Wend
I got following problem I cannot get pass.
I am trying to create recordset in loop. Idea is to add to database some entries related to user selected date ranges in user form. When user selects just one date code works fine but when user selects date ranges it crashes with above runtime error on second loop pass - invalid object or has no values.
Here is my code (part of it in fact, a bit simplified to show the problem):
Dim sql, sql2 As String
Dim x, daty As Integer
Dim dbs As DAO.Database
Set dbs = CurrentDb
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
For x = 0 To 3 '''replaced user selected date ranges with 3 to simplify code
sql = "INSERT INTO tDzialaniaRejestracja (IdSzkolenia, TerminRozpoczecia) VALUES (" & Me.IdSzkolenia & ", '" & Format((Me.DataRozpoczecia + x), "dd.mm.yyyy") & "')"
With dbs
Set qdf = dbs.CreateQueryDef("", sql) '''here i get runtine error 3420 on second loop pass
qdf.Execute dbFailOnError
sql2 = "SELECT ##IDENTITY"
Set rs = .OpenRecordset(sql2, dbOpenDynaset)
lastID = rs.Fields(0)
rs.Close
dbs.Close
End With
Me.IdDzialania = lastID
Me.ProwadzacyFirmaZewn.Value = 23
Set qdf = Nothing
Set rs = Nothing
Next x
Any tips greatly appreciated.
Thank you very much in advance.
regards
I have tried this small piece and it gave me 3420 on the second loop as well.
Sub TestMe()
Dim dbs As DAO.Database
Dim qdf As DAO.QueryDef
Set dbs = CurrentDb
Dim x As Long
For x = 0 To 3
Set qdf = dbs.CreateQueryDef("", "SELECT * FROM TABELLE1")
dbs.Close
Next x
End Sub
Thus, the problem is that you are closing the dbs in the first iteration and then you are refering against to it.
Don't create a new query for every loop iteration. Just use one query, and use parameters to insert different data.
The real problem, as Vityata pointed out, is that you're closing dbs on the first iteration. I've fixed that as well. But I just couldn't not optimize this code...
Dim sql, sql2 As String
Dim x, daty As Integer
Dim dbs As DAO.Database
Set dbs = CurrentDb
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
sql = "INSERT INTO tDzialaniaRejestracja (IdSzkolenia, TerminRozpoczecia) VALUES (#Param1, #Param2)"
Set qdf = dbs.CreateQueryDef("", sql)
For x = 0 To 3
qdf.Parameters("#Param1") = Me.IdSzkolenia
qdf.Parameters("#Param2") = Format((Me.DataRozpoczecia + x), "dd.mm.yyyy")
With dbs
qdf.Execute dbFailOnError
sql2 = "SELECT ##IDENTITY"
Set rs = .OpenRecordset(sql2, dbOpenDynaset)
lastID = rs.Fields(0)
rs.Close
End With
Me.IdDzialania = lastID
Me.ProwadzacyFirmaZewn.Value = 23
Set rs = Nothing
Next x
'Not necessary, no benefit whatsoever in the following code, but it goes here if you want it
dbs.Close
Set dbs = Nothing
Set qdf = Nothing
This has many additional advantages, such as allowing Access to compile the query only once, simplifying your code, avoiding possible SQL injection, etc.
I have a MS ACCESS query called Query11 that sums up amounts.
Let's say it's got SUM_WEEKLY and SUM_MONTHLY as a field in Query11
In VBA, how could I get each value?
I have tried to get them with the codes below and it did not work.
Dim dbMyDB As Database
Dim rsMyRS As Recordset
Set dbMyDB = CurrentDb
Set rsMyRS = dbMyDB.OpenRecordset("Query11")
MsgBox rsMyRS("SUM_WEEKLY")
MsgBox rsMyRS("SUM_MONTHLY")
Your code should work, and you don't tell the error, but try to be a bit more explicit:
Dim dbMyDB As DAO.Database
Dim rsMyRS As DAO.Recordset
Set dbMyDB = CurrentDb
Set rsMyRS = dbMyDB.OpenRecordset("Query11")
' Check that a record exists.
MsgBox CStr(rsMyRS.RecordCount)
MsgBox rsMyRS("SUM_WEEKLY").Value
MsgBox rsMyRS("SUM_MONTHLY").Value
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("Query11")
' Check a record exists
If rs.RecordCount > 0 Then
MsgBox "SUM_WEEKLY = " & rs!SUM_WEEKLY
MsgBox "SUM_MONTHLY = " & rs!SUM_MONTHLY
Else
MsgBox "Recordset has no records"
End If
I have a problem that my IF somehow doesn't validate good value of the field on index 0.
Here is the UDPATED code:
Private Sub Parametri()
Dim db As dao.Database
Dim rs As dao.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("ribe")
rs.MoveLast
rs.MoveFirst
For i = 0 To rs.RecordCount
If rs.Fields(i).Value > 2 Then
Debug.Print rs.Fields("Lokacija_GS")
rs.MoveNext
End If
Next
End Sub
And here is the result:
1
43.626145
43.626145
43.630122
43.632358
43.625833
This value of "1" on index 0 should be skipped... but it isnt?
here is the table:
So for example if some row is 0 or 1 or NULL I want to skip it...
Here is the correct code,
Private Sub Parametri()
Dim db As dao.Database
Dim rs As dao.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("ribe")
rs.MoveLast
rs.MoveFirst
Do While Not rs.EOF
If rs.Fields("Lokacija_GS").Value > 2 Then _
Debug.Print rs.Fields("Lokacija_GS")
rs.MoveNext
Loop
Set rs = Nothing
Set db = Nothing
End Sub