I have DAO recordset that is generated with pass-through query to postgresql stored function. I use it to fill out combobox in my form. What I need is additional item in combobox with "AllItems" description. But the recordset is read-only (that's normal in this case). So I cannot just add new row to it. Can I do any kind of in memory recordset clone, copy or anything like that to make addition possible? I don't want to update recordsource. And I don't want to hardcode this option in to the pgsql function as well.
Public Sub fillCboAssortmentType()
Dim rs As DAO.Recordset
If (lngViewContext = acMyItems) Then
Set rs = getAssortmentTypesByDAO(TempVars!loggedUser)
Else (lngViewContext = acAllItems) Then
Set rs = getAssortmentTypesByDAO
End If
' It wont work, because the rs is RO
With rs
.AddNew
!type_id = 0
!type_name = "***AllItems***"
End With
' It wont work neither, because cboTypeFilter rowsource is Table/Query
Set Me.cboTypeFilter.Recordset = rs
Me.cboTypeFilter.AddItem "0;***AllItems***"
End Sub
Any suggestions?
TY All.
I think you are asking for a "In Memory" Recordset. Let's assume you have a table which looks like this
Then the following code will read the values from the table and copy it to a in memory recordset and add a new value but only in memory
Option Compare Database
Option Explicit
Sub inMemory()
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
With rs.Fields
.Append "val", adVarChar, 64
End With
Dim sourceRs As DAO.Recordset
Dim db As DAO.Database
Set db = CurrentDb
Set sourceRs = db.OpenRecordset("SELECT * FROM tbl")
Dim i As Long
rs.Open
Do Until sourceRs.EOF
rs.AddNew
rs.Fields(0).Value = sourceRs.Fields(0).Value
rs.Update
sourceRs.MoveNext
Loop
rs.AddNew
rs.Fields(0).Value = "Cancel"
rs.Update
' let's print the list just for testing
rs.MoveFirst
Do Until rs.EOF
Debug.Print rs.Fields(0).Value
rs.MoveNext
Loop
End Sub
Related
This question already has answers here:
Vba Access error 91
(2 answers)
Closed 5 years ago.
I'm working with a couple tables, CTOL and CTOL_Asbuilt in Access. I'm trying to run a query to join these two tables together using VBA code. I ran the query in Access and it works. I'm using DAO for the database library to retrieve data from the local Access database (code is in the same database project as the database), and I'm new to VBA Access scripting.
SELECT CTOL.ID, CTOL.BOM_PART_NAME, CTOL.CII, CTOL.[PART FIND NO], CTOL.CSN,
CTOL.AFS, CTOL.EQP_POS_CD, CTOL.LCN, CTOL.POS_CT, CTOL.SERIAL_NO,
CTOL.PART_NO_LLP, [CTOL_Asbuilt].[PART-SN], [CTOL_Asbuilt].[PART-ATA-NO],
[CTOL_PW-E750207_Asbuilt].[PW-PART-NO]
FROM CTOL LEFT JOIN [CTOL_Asbuilt] ON CTOL.[PART FIND NO] = [CTOL_Asbuilt].[PART-ATA-NO];
This is the code below:
Option Compare Database
Option Explicit
'Const adOpenStatic = 3
'Const adLockOptimistic = 3
Function queryDatabase()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsQuery As DAO.Recordset
Dim part_find_no() As String
Dim eqp_pos() As Integer
'Dim strSQL As String
Dim i As Integer
Dim j As Integer
'Set objConnection = CurrentDb.OpenRecordset("CTOL")
Set db = CurrentDb
Set rsQuery = db.OpenRecordset("SicrProcess", dbOpenDynaset)
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Function
I'm getting the following error when I run this code with a macro that calls the function:
Run time error '91':
Object variable or With block variable not set
I'm trying to use the code with the query to loop through two fields and increment the value of the EQP_POS_CD field when the PART FIND NO entry matches the last (else, it just moves to the next record until it reaches the end of the result set). I want to test-run this query to make sure that the code retrieves the result that is output by running the query manually in Access.
Can you help me in fixing this error so I can run my code to retrieve the data? Thanks!
rs.Close
You cannot close something that is not open. Perhaps you meant it to be rsQuery.Close?
Open a recordset and loop through records.
Sub queryDatabase()
On Error GoTo ErrProc
Dim db As DAO.Database
Set db = CurrentDb
Dim qdf As DAO.QueryDef
Set qdf = db.QueryDefs("SicrProcess") 'set your query name here
Dim rs As DAO.Recordset
Set rs = qdf.OpenRecordset(dbOpenDynaset)
Dim part_find_no() As String
Dim eqp_pos() As Integer, i As Integer
If rs.EOF Then GoTo Leave
rs.MoveLast
rs.MoveFirst
For i = 1 To rs.RecordCount
'...
'Do work here
'...
rs.MoveNext
Next i
Leave:
On Error Resume Next
rs.Close
Set rs = Nothing
qdf.Close
Set qdf = Nothing
Set db = Nothing
On Error GoTo 0
Exit Sub
ErrProc:
MsgBox Err.Description, vbCritical
Resume Leave
End Sub
Is it possible to get the values from rows in an Access table that are showing after the filter is applied?
Example as requested:
I have a table in which employees fill in project tasks, hours on the project etc.
It is made as a table on a form. The columns has limited choices in Initials, Project number, etc. People like to sort the table by the built in filter function in access tables and queries. I filtered so only the project LT1075 is shown in the example.
How can i get those 4 rows as a recordset or something similar? I need to get the values in all hour fields. I need also to copy only those 4 lines in VBA and do stuff to it (Functions wanted by people). But when i use the DAO, i get all rows in the "Unfiltered" table.
How do i get only the rows visible?
In excel, there is a simple function, something with cells_visible but i cant find a pardon to Access.
Best Regards, Emil.
Edit, tryouts:
Public Sub Test1_Click()
Dim rs As DAO.Recordset
Set rs = Me.RecordsetClone
While Not rs.EOF
' Do calculation stuff on record.
rs.MoveNext
Wend
End Sub
It is put on the "Test 1" button in the figure above.
I get the error: "Runtime error 7951 - You entered an expression that has an invalid reference to the RecordsetClone property"
I have a clue that it does not work because of the Me.* function? Since the table is in some sort of subform. But i see only one form in the Navigation panel. (Hidden are also showed).
You can use the RecordsetClone of the form:
Dim rs As DAO.Recordset
Set rs = Me.RecordsetClone
While Not rs.EOF
' Do calculation stuff on record.
rs.MoveNext
Wend
And you can add records to a recordset:
Public Sub CopyRecords()
Dim rstSource As DAO.Recordset
Dim rstInsert As DAO.Recordset
Dim fld As DAO.Field
Dim strSQL As String
Dim lngLoop As Long
Dim lngCount As Long
strSQL = "SELECT TOP 1 * FROM tblStatus"
Set rstInsert = CurrentDb.OpenRecordset(strSQL)
' rstSource can be any recordset, here the RecordsetClone of the form.
Set rstSource = Me.RecordsetClone
With rstSource
While Not .EOF
With rstInsert
.AddNew
For Each fld In rstSource.Fields
With fld
If .Attributes And dbAutoIncrField Then
' Skip Autonumber or GUID field.
ElseIf .Name = "Total" Then
' Special cases.
' Insert default job code.
rstInsert.Fields(.Name).Value = 0
ElseIf .Name = "PROCESSED_IND" Then
rstInsert.Fields(.Name).Value = vbNullString
Else
' Copy field content.
rstInsert.Fields(.Name).Value = .Value
End If
End With
Next
.Update
End With
.MoveNext
Next
rstInsert.Close
.Close
End With
Set rstInsert = Nothing
Set rstSource = Nothing
End Sub
When I use a recordset to read from a table everything works fine and the recordcount function shows me the correct amount, but when I use this simple query or any query I always get 1 as a recordcount.
Here's whats working
Option Compare Database
Option Explicit
Public Sub LoadQ2()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("test")'test is the name of my table which contains 13 rows
With rs
Debug.Print .RecordCount
.Close
End With
Set db = Nothing
Set rs = Nothing
End Sub
and here's whats not working
Option Compare Database
Option Explicit
Public Sub LoadQ2()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT test.number_id FROM test"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
With rs
Debug.Print .RecordCount
.Close
End With
Set db = Nothing
Set rs = Nothing
End Sub
I should get the same result with both recordcount right?? Also I'd like to see the line I have in the recordset in the debug is it possible to print the content of the recordset in the debug window??
To print the contents of the recordset, you can do one of these two options..
debug.print rs.fields(0) & ", " & rs.fields(1)
or
debug.print rs("ColumnNameHere") & ", " & rs("AnotherColumnName")
.... found the answer
before doing the Debug.Print .RecourdCount i added .MoveLast and got the right number of recordcount
Looks like recordcount just means at what record that he is not how many records
Just to complement as you already found the answer yourself :)
The Dynaset data type (default for DAO recordset) doesn't fully populate until you go through all its records - since the need to do a .MoveLast before checking how many records it actually has.
I presume that DAO just returns 1 for the recordcount as an easy way to check beforehand if the recordset is empty or not (e.g. recordcount > 0) without having to go through the hassle of moving between records.
I'm trying to write a piece of code that will run through a table and replace every field that has a certain value with another value.
Private Sub Form_Load()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb()
strSQL = "SELECT Profile3 FROM Bank WHERE 'AB'"
Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
Do Until rst.EOF
With rst
If .RecordCount > 0 Then
.MoveFirst
.Edit
!Profile3 = "AA"
.Update
.MoveNext
End If
End With
Loop
End Sub
That's what I'm currently using, however, when it runs it crashes horribly. I know the base code works because when I pull out the loop it works, but only on the first entry.
Like most of the issues I seem to have with VBA, it's probably an absurdly simple fix that I am overlooking.
Thank you for your help.
You are constantly moving first. You need to get on at some stage. Just get rid of MoveFirst.
Do Until rst.EOF
With rst
.Edit
!Profile3 = "AA"
.Update
.MoveNext
End With
Loop
In addition, I guess you mean WHERE somefield:
strSQL = "SELECT Profile3 FROM Bank WHERE somefield='AB'"
However, in this case, I suspect what you need is:
strSQL = "UPDATE Bank SET Profile3 ='AA' WHERE Profile3 ='AB'"
CurrentDB.Execute strSQL, dbFailOnError
so if i do a SQL statement like so:
sql = "SELECT * FROM tblMain"
set rs = currentdb.openrecordset(sql)
what method can i use to view every "field name" in this collection i have just created. i am getting some very strange error stating that the item is not found in this collection.
i know the field exists in the table, i have triple checked the spelling everywhere when i reference it, and the SQL should be pulling everything, but i want to see it.
is there a debug.print method to see all these fields
thanks
Justin
This is a variation on the other answers, but I believe it's better to use a For/Each loop than a counter:
Dim rs As DAO.Recordset
Dim fld As DAO.Field
Set rs = CurrentDB.OpenRecordset("SELECT * FROM tblMain")
For Each fld In rs.Fields
Debug.Print fld.Name
Next fld
Set fld = Nothing
rs.Close
Set rs = Nothing
You can iterate through the fields collection of the recordset.
Code is OTTOMH
Dim NumFields as Integer
For NumFields = 0 to rs.Fields.Count -1
Debug.Print Rs.Fields(NumFields).Name
Next
Alternately, you can set a breakpoint at set rs = currentdb.openrecordset(sql) and then as soon as the statement executes, right-click on rs, choose add watch and view the whole thing in the Watches window.
Here is a script that will look for a field containing the string you specify in every table in an Access database (except System and Attached Tables) and write it to text files:
Option Compare Database
Option Explicit
Sub main()
Dim db As Database
Dim rs As Recordset
Dim bFinished As Boolean
Dim sFieldName As String
Dim iPosition, z, x As Integer
Dim bRetVal As Boolean
Dim tdTemp As TableDef
Dim iDatabaseNumbers As Integer
Const FIELD_TO_FIND = "FieldName"
Set db = CurrentDb
Open Left(db.Name, Len(db.Name) - 4) & "_" & FIELD_TO_FIND & ".txt" For Output As #1
For x = 0 To db.TableDefs.Count - 1
Set tdTemp = db.TableDefs(x)
bRetVal = IIf(tdTemp.Attributes And dbSystemObject, False, True)
If bRetVal Then
bRetVal = IIf(tdTemp.Attributes And dbAttachedTable, False, True)
End If
If bRetVal Then
Set rs = db.OpenRecordset(db.TableDefs(x).Name)
If rs.RecordCount > 0 Then
For z = 0 To rs.Fields.Count - 1
sFieldName = rs.Fields(z).Name
If InStr(1, sFieldName, FIELD_TO_FIND, vbTextCompare) > 0 Then
Print #1, db.TableDefs(x).Name
Exit For
End If
Next z
End If
End If
Next x
Close #1
MsgBox "Done"
End Sub
You could adjust accordingly to make it do what you need.