I am trying to create a function that will check all the check boxes in a form with a
datasheet subform.
Since we moved to Office 2013 this code stopped working and it seems that moving to ADO is the only way.
Private Sub Toggle_Click()
Dim sfrm
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
sfrm = Me.Subform
Set cn = CurrentProject.Connection
'Dim rs As DAO.Recordset
'Set rs = Me.Subform.Form.RecordsetClone
rs.Open Me.Recordset
If (theTop = 0) Then
Else
Me.Subform.Form.AllowAdditions = False
Dim i As Integer
If (theHeight = 0) Then
If (sfrm![Ready?] = -1) Then
sfrm![Ready?] = 0
sfrm![Timestamp] = Null
Else
sfrm![Ready?] = -1
sfrm![Timestamp] = Date
End If
Else
On Error Resume Next
For i = theTop To rs.RecordCount
'If (i = 1) Then
'Else
'End If
'rs.MoveLast
'Do While Not rs.BOF
If (sfrm![Ready?] = -1) Then
sfrm![Ready?] = 0
sfrm![Timestamp] = Null
Else
sfrm![Ready?] = -1
sfrm![Timestamp] = Date
End If
'Me.Subform.Form.Recordset.MoveNext
rs.MoveNext
'Debug.Print sfrm![Routing Number]
'Loop
Next
End If
Me.Subform.Form.AllowAdditions = True
End If
End Sub
it seems that moving to ADO is the only way
With Access 2013, DAO remains the preferred way to interact with Access database objects from within the Access application itself. In my opinion it would be wise for you to investigate why the previous DAO code is failing (and how you might fix it) before embarking on a wholesale conversion of DAO code to ADO.
I just did a test in Access 2013. With [ParentTable}
[ChildTable]
and a form like this
I could toggle the [Selected?] status of the current subform records with the following code:
Option Compare Database
Option Explicit
Private Sub cmdToggleChildren_Click()
Dim rst As DAO.Recordset
Set rst = Me.ChildSubform.Form.Recordset
If Not (rst.BOF And rst.EOF) Then
rst.MoveFirst
Do Until rst.EOF
rst.Edit
rst![Selected?] = Not rst![Selected?]
rst.Update
rst.MoveNext
Loop
End If
Set rst = Nothing
End Sub
Related
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
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
I am trying to track value changes when editing a record. All fields on the form are unbound text box.
Below is a function that is used to insert a audit tracking record.
Public Function AuditChanges(RecordID As String, UserAction As String)
Dim DB As Database
Dim rst As Recordset
Dim clt As Control
Dim Userlogin As String
Set DB = CurrentDb
Set rst = DB.OpenRecordset("select * from tbl_audittrail", adOpenDynamic)
Userlogin = Environ("username")
Select Case UserAction
Case "Edit"
For Each clt In Screen.ActiveForm.Controls
If (clt.ControlType = acTextBox _
Or clt.ControlType = accombox) Then
If Nz(clt.Value) <> Nz(clt.OldValue) Then
With rst
.AddNew
![DateTime] = Now()
!UserName = Userlogin
!FormName = Screen.ActiveForm.Name
!Action = UserAction
!RecordID = Screen.ActiveForm.Controls(RecordID).Value
!FieldName = clt.ControlSource
!OldValue = clt.OldValue
!Newvalue = clt.Value
.Update
End With
End If
End If
Next clt
End Select
rst.Close
DB.Close
Set rst = Nothing
Set DB = Nothing
End Function
Below is how I use the function:
Private Sub btnUpdate_Click()
Set DB = CurrentDb
Set rs = DB.OpenRecordset("SELECT * FROM ASID", dbOpenDynaset, dbSeeChanges)
rs.Edit
rs!ISIN = Me.ISIN
rs!SECIDTYPE = Me.SECIDTYPE
rs!ALTSECID = Me.ALTSECID
rs.Update
Call AuditChanges("ISIN", "Edit")
End If
End Sub
The problem is when it calls AuditChanges, it goes directly from
If (clt.ControlType = acTextBox _
Or clt.ControlType = accombox)
to End If
All fields on current form are unbound text boxes and you have to press an "Add" command button to actually add a record. I think there must be something wrong with the control type but I am not sure which control type should be used. Any idea?
Start by putting Option Explicit at the top of each module.
It enforces variable declaration and reports undeclared or misspelled variables/constants at compile time.
To have this automatically in new modules, set the Require Variable Declaration option in the VBA Editor.
This is really a must have for VBA development.
Then the compiler will tell you that accombox doesn't exist, it should be acComboBox
Without Option Explicit, accombox is initialized as NULL variant, and causes your entire If condition to be NULL, and therefore never be entered.
I have a Subform/Subreport control displayed on a Form in an Access 2010 database, and I use it to display both Forms and Reports. I have a few event handlers in which I need to know whether a Report is currently loaded into the Subform/Subreport control, or if it's a Form that's loaded. I have tried all of the following to no avail.
Any of the following conditions
If IsEmpty(NavigationSubform.Form) Then '...
If IsNull(NavigationSubform.Form) Then '...
If IsOject(NavigationSubform.Form) Then '...
If NavigationSubform.Form Is Nothing Then '...
If NavigationSubform.Form Is Null Then '...
If Nz(NavigationSubform.Form) Then '...
If (Not NavigationSubform.Form) = -1 Then '... This is a trick I use to check for uninitialized arrays
Results in
Run-time error '2467':
The expression you entered refers to an object that is closed or doesn't exist.
Is there some way that I can check whether a Subform/Subreport control currently has a Form or Report loaded without intentionally causing an error?
I don't believe that there is a way to reliably perform the check without error trapping, so you may want to wrap the code in a Public Function and put it into a regular VBA Module:
Public Function CheckSubformControlContents(ctl As SubForm) As String
Dim obj As Object, rtn As String
rtn = "None"
On Error Resume Next
Set obj = ctl.Form
If Err.Number = 0 Then
rtn = "Form"
Else
On Error Resume Next
Set obj = ctl.Report
If Err.Number = 0 Then
rtn = "Report"
End If
End If
Set obj = Nothing
On Error GoTo 0
CheckSubformControlContents = rtn
End Function
Then your form code can simply call CheckSubformControlContents(Me.NavigationSubform).
Here are two functions that work in Access 2013 for determining if a name is a Report or a Form.
Once that is determined the IsLoaded function of AllForms or AllReports can be used. Note that dbs is an object and rpt or frm are AccessObjects not forms or reports
Public Function IsForm(FormName As String) As Boolean
Dim dbs As Object
Dim frm As AccessObject
Set dbs = Application.CurrentProject
IsForm = False
For Each frm In Application.CurrentProject.AllForms
If frm.Name = FormName Then
IsForm = True
Exit For
End If
Next frm
Set frm = Nothing
Set dbs = Nothing
End Function
Public Function IsReport(ReportName As String) As Boolean
Dim dbs As Object
Dim rpt As AccessObject
Set dbs = Application.CurrentProject
IsReport = False
For Each rpt In Application.CurrentProject.AllReports
If rpt.Name = ReportName Then
IsReport = True
Exit For
End If
Next rpt
Set rpt = Nothing
Set dbs = Nothing
End Function
Here is a program that uses the above functions:
Public Sub EnumerateTaggedControls(ReportName As String, MyTag As String)
Dim dbs As Object
Dim rpt As Report
Dim frm As Form
Dim col As Controls
Dim ctl As Control
Dim left As Integer
Dim top As Integer
Dim width As Integer
Dim height As Integer
Dim tag As String
Dim i As Integer
Const format1 As String = "0000 "
Set dbs = Application.CurrentProject
If IsForm(ReportName) Then
If dbs.AllForms(ReportName).IsLoaded Then
DoCmd.OpenForm ReportName, acViewDesign
Set frm = Forms(ReportName)
Set col = frm.Controls
End If
Else
If dbs.AllReports(ReportName).IsLoaded Then
DoCmd.OpenReport ReportName, acViewDesign
Set rpt = Reports(ReportName)
Set col = rpt.Controls
Else
Debug.Print ReportName & " is not a loaded form or report."
Exit Sub
End If
End If
Set dbs = Nothing
Debug.Print Tab(53); "Left Top Width Height"
For Each ctl In col
With ctl
left = .Properties("Left")
top = .Properties("Top")
width = .Properties("Width")
height = .Properties("Height")
tag = Nz(.Properties("Tag"), vbNullString)
If MyTag = "" Then
i = 1
Else
i = InStr(1, tag, MyTag)
End If
If i > 0 Then
Debug.Print .Name & ">"; Tab(33); tag; Tab(53); Format(left, format1) & Format(top, format1) & Format(width, format1) & Format(height, format1)
End If
End With
Next ctl
Debug.Print "====================================================="
Set ctl = Nothing
Set rpt = Nothing
Set col = Nothing
Set frm = Nothing
End Sub
I hope this meets your requirements.
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.