Loop through MS Access subform and get column visibility - vba

I am using one tab control with numerous pages, each stores one subform with a different number of columns. Every subform has to display some basic information, and on demand even more. The OnLoad event of each subform defines which column may visible or not.
As part of an export tool, I am trying to build a loop which returns every field name, field caption and the visibility of the column as a boolean.
Dim strAns As String
Dim ctl As Control
Dim sfrm As SubForm
Set sfrm = Forms![frm_Main]![frm_Sub]
For Each ctl In sfrm.Controls
strAns = ctl.Name & "_" & ctl.Caption & "_" & ctl.columnVisible
Debug.Print strAns
Next ctl
Currently it runs only using ctl.Name, but I have the feeling this may not be the right syntax for my use-case. It returns every field name AND additionally the name of the textbox beneath it in a new line, so basically this is twice as much information I need.
Does anyone have an idea, how to reach the other two properties?

For those who have the same problem, here is a possible workaround! In the meantime I figured out that I doesn't necessarily need the .Caption for my specific use-case.
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rstQry As DAO.Recordset
Dim fldQry As DAO.Field
Set db = CurrentDb
Set qdf = db.QueryDefs("qrySource_frmSub")
Set rstQry = qdf.OpenRecordset
Dim dictHidden As New Scripting.Dictionary
For Each fldQry In rstQry.Fields
dictHidden.Add fldQry.Name, False
Next fldQry
qdf.Close
Dim frm As SubForm
Set frm = Forms![frm_Main]![frm_Sub]
For Each key In dictHidden.Keys
dictHidden(key) = frm.Controls.item(key).ColumnHidden
Next key

Related

Access 2016 - RecordsetClone Error on a form constructed with a virtual recordset opens "Select Data Source" dialog

I've seen a number of posts trying to describe this bug but they haven't framed the problem correctly to be reproduced... or not set the scenario in the way that I've experienced the bug using a common technique.
The bug occurs when a form's recordset is set to a virtual recordset and then referred to by a DAO recordsetclone statement. Instead of the recordset being set to the form's recordset (via cloning), a "Select Data Source" dialog is presented.
We most commonly use this to add a checkbox control to a detail form for a user to select one or more records for further processing. I've used this technique many times in many applications but now it fails.
Note: I have confirmed that this code works correctly in Access 2010.
I'm using Windows 10 Pro with a 32 bit Office installation
To set this up and reproduce the bug:
Create a new ACCDB database
Add the following references to the default references:
Microsoft ActiveX Data Objects 6.1 Library
Microsoft ADO Ext. 2.8 for DDL and Security
Create a testing table:
TestId, AutoNumber, PK
TestText, Short Text
Append about 10 rows to the table.
Create an unbound form with 3 controls:
Checkbox, Name: Selected, Control Source: Selected
Textbox, Name: TestId, Control Source: TestId
Textbox, Name: TestText, Control Source: TextText
In the form's header add a command button: Name: cmdTest, Caption: Test
Set the form Default View: Continuous
In the Form_Open call a sub SetRecordsource which creates a recordset and adds a column "Selected" for the user to check the records they want.
The command button cmdTest will attempt to reference the form's recordsource. It's while attempting to reference the form's recordsouce that the error occurs. Instead of the reference being made, the "Select Data Source" dialog pops up.
The complete form's VBA code:
Option Compare Database
Option Explicit
Private Sub cmdTest_Click()
On Error GoTo errHandler
Dim rs As DAO.Recordset
Set rs = Me.RecordsetClone
' Using an ADODB recordset works but is an ugly solution
' To test comment out the Dim DAO and Set rs statements above and uncomment the next 2 lines.
' Dim rs As ADODB.Recordset
' Set rs = Me.Recordset
rs.MoveFirst
With rs
Do While Not .EOF
Debug.Print .Fields("Selected"), .Fields("TestId"), .Fields("TestText")
.MoveNext
Loop
End With
Set rs = Nothing
ExitSub:
Exit Sub
errHandler:
MsgBox "Error in " & Me.Name & ".SetRecordsource " & Err.Number & " - " & Err.Description
Resume ExitSub
End Sub
Private Sub SetRecordsource()
Dim rs As ADODB.Recordset 'the virtual recordset to hold the source data plus the boolean Selected field
Dim rsSource As DAO.Recordset 'dim the source recordset
Set rs = New ADODB.Recordset
With rs
.Fields.Append "Selected", adboolean
.Fields.Append "TestId", adInteger, , adFldKeyColumn
.Fields.Append "TestText", adVarChar, 80
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
.Open
Set rsSource = CurrentDb.OpenRecordset("Select TestId, TestText from Test", dbOpenDynaset)
rsSource.MoveFirst
Do Until rsSource.EOF
.AddNew
.Fields("Selected") = 0 'set the checkboxes to unchecked
.Fields("TestId") = rsSource.Fields(0)
.Fields("TestText") = rsSource.Fields(1)
.Update
rsSource.MoveNext
Loop
End With
Set Me.Recordset = rs 'Set the form's recordset = to our virtual recordset
Set rsSource = Nothing
Set rs = Nothing
ExitSub:
Exit Sub
err_handler:
MsgBox "Error in " & Me.Name & ".SetRecordsource " & Err.Number & " - " & Err.Description
Resume ExitSub
End Sub 'SetRecordsource
Open the form and click the Test command button to reproduce the error.
One solution proposed is to use an ADODB recordset and set it to Me.Recordset instead of Me.Recordsetclone. While this does work, it's an ugly solution since you are now operating on the form's recordsource and when looping through the records to find the rows where Selected = True moves the current record on the form. Not only does the current record pointer move but if there's more rows then the can show, the user sees the form's records scrolling.
Any help, confirmation or recommendations would be greatly appreciated.
Thanks in advance!
From another forum the solution to this is to use an ADODB recordset and then clone the form to it via Recordset.Clone. In the code above, it references an "ugly" solution:
' Using an ADODB recordset works but is an ugly solution
' To test comment out the Dim DAO and Set rs statements above and uncomment the next 2 lines.
' Dim rs As ADODB.Recordset
' Set rs = Me.Recordset
Setting rs = Me.Recordset will operate on the form (not desired).
But using an ADODB recordset and then
setting rs = Me.Recordset.Clone works, does not operate on the form and doesn't pop up the Data Source Dialog.
Something has changed in 2016 but this does work and may help someone else.
You may also want to read: Create In-Memory ADO Recordsets at Database Journal
Your code can't work, as you try to assign an ADODB.Recordset (the one in Form.Recordset) to a DAO.Recordset,`as it is declared.
If the Recordset-Type can vary, you can dimrs as Objectthen it gets the type of Form.Recordset(by Form Property RecordsetClone, that surprisingly works for ADODB:Recordsets too). You can query the type with:
If TypeOf Me.RecordSet Is ADODB.Recordset Then
'ADODB
Else
'DAO
End If
If you need an unboundCheckBox, you can useclsCCRecordSelect-Class from SelectRecordsV2.
TheclsCCRecordSelectis used by me for years and I don't want to live without!

How to fill multiple Bookmarks / FormFields in Word from the same field in Access using VBA

I had previously been using some VBA to pass fields from Access into a Word document, until coming up against the 255 character limit. Assistance from this site has led me to now use Bookmarks instead of Form Fields.
I was originally filling many different fields on Word and in some instances using the same data from Access in two places on the Word document. I was achieving this by calling:
.FormFields("txtReasonforReward").Result = Me![Reason for Reward]
.FormFields("txtReasonforReward2").Result = Me![Reason for Reward]
As I now have a different way of filling the "Reason for Reward" box, to circumvent the character limit (code below), I'm not sure how to fill "txtReasonforReward2". I do have several instances where I've added a second field and stuck a 2 on the end... I'm not convinced this is the best way so if anybody can advise on how to achieve this with both FormFields and Bookmarks, I'd be really grateful.
Dim objWord As Object
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set doc = objWord.Documents.Open(***path to file***, , True)
Dim rng As Word.Range
Dim x As String
With doc
.FormFields("txtFirstName").Result = Me![First Name]
.FormFields("txtLastName").Result = Me![Last Name]
`examples cut for clarity...
.FormFields("txtHRID").Result = Me![ID]
.FormFields("txtPeriod").Result = Me![Period]
If doc.ProtectionType <> wdNoProtection Then
doc.Unprotect
End If
Set rng = doc.Bookmarks("txtReasonforReward").Range
rng.MoveStart wdCharacter, -1
x = rng.Characters.First
rng.FormFields(1).Delete
rng.Text = x & Me![Reason for Reward]
doc.Protect wdAllowOnlyFormFields, True
.Visible = True
.Activate
End With
objWord.View.ReadingLayout = True
Building on the code in the question and the background question...
Word can duplicate the content of a bookmark using REF field codes. Since form fields also use bookmark identifiers, this will work with existing form fields as well as bookmarked content. REF fields can be inserted directly, if a person is familiar with doing so OR by inserting a cross-reference to the bookmark.
Referring to the work-around for inserting more than 255 characters, in this case it will be necessary to also place a bookmark around the range being inserted and to update the REF fields so that they mirror the bookmark content throughout the document. The modified section of code is below.
'Declarations to be added at the beginning of the procedure
Dim fld As Word.Field
Dim bkmName As String
'Name of form field, bookmark to be added and text in REF field code
bkmName = "txtReasonforReward"
'Existing code
If doc.ProtectionType <> wdNoProtection Then
doc.Unprotect
End If
Set rng = doc.Bookmarks(bkmName).Range
rng.MoveStart wdCharacter, -1
x = rng.Characters.First
rng.FormFields(1).Delete
rng.Text = x & Me![Reason for Reward]
' New code
'Leave that single character out of the range for the bookmark
rng.MoveStart wdCharacter, 1
'Bookmark the inserted content
doc.Bookmarks.Add bkmName, rng
'Update fields so that REF's pick up the bookmark content
For Each fld In doc.Fields
If fld.Type = wdFieldRef Then
fld.Update
End If
Next
doc.Protect wdAllowOnlyFormFields, True
This approach will get a bit unwieldy if it needs to be applied to many fields. It might make sense to do something like write the bookmark names to a Tag property of the controls in the Access form then loop the controls to pick up bookmark name and data from the control, rather than writing each out explicitly - but this is just a thought for the future.
All that being said, the "modern" way to achieve this is to work with content controls instead of form fields/bookmarks. Content controls do not have the 255 character limit, the document can be protected as a form, multiple content controls can have the same title (name) and/or tag. Furthermore, content controls can be "mapped" to a Custom XML Part stored in the document so that changing the content of one will change the content of another. Trying to describe all that would go beyond what should be in an "answer", here, but is all publicly available by searching the Internet.
Personally, if this were my project and knowing what I know of it: If form fields are not required in the document (no user input via the fields is expected) I would use bookmarks and REF fields, only.
There are so may ways to do this kind of thing. Take a look at the approach below and see if you can get it to work.
Option Compare Database
' This concept uses Docvariables in MS Word
Sub PushToWord()
Dim wapp As Word.Application
Dim wdoc As Word.Document
Dim db As DAO.Database
Dim fld As DAO.Field
Dim rs As DAO.Recordset
Dim filenm As String
Dim NumFields As Integer
Dim i As Integer
Set db = CurrentDb
Set rs = db.OpenRecordset("tbl_CustomerData")
Set wapp = New Word.Application
wapp.Visible = True
Set rs = DBEngine(0)(0).OpenRecordset("SELECT * FROM tbl_CustomerData")
If rs.RecordCount > 0 Then
rs.MoveFirst
Do While Not rs.EOF
For i = 0 To rs.Fields.Count - 1
Set fld = rs.Fields(i)
Debug.Print fld.Name, fld.Value
If fld.Value = 20 Then
filenm = "C:\Users\Ryan\Desktop\Coding\Integrating Access and Word\From Access to Word\Letter1.doc"
Set wdoc = wapp.Documents.Open(filenm)
wapp.ActiveDocument.Variables("Name").Value = rs.Fields("Name").Value
End If
Next
rs.MoveNext
Loop
Set fld = Nothing
rs.Close
End If
Set rs = Nothing
End Sub
The code runs from Access, and you can fire it off any number of ways (button click event, form load event, some other object event, etc.)

In a continuous form, can I have a combo box use a different query depending on a field or text box value within its own record?

Edit: for those wondering, it's apparently impossible to have the same combo box for two different records in a continuous form refer to two different queries to populate its list.
I have a continuous form that has maybe 5 records. There is a combo box, Laborer1, and would like the dropdown to be different for each form, depending on some other factors. I managed to put the exact query I want for each record's combo box as a text field within that record. What is the next step? All I can manage at this point is apply the query of one record to all combo boxes, but I want each combo box to use its "own" query.
Thanks!
Yes, you can do it, but there's a tradeoff: inactive records may have a value which doesn't fit within the current rowsource for the combobox. When that happens, you'll get a blank combobox, instead of having it show the current value. If you activate the record, the value will appear again, but it's not a fantastic user experience.
That said, one option would be to handle it in the Form_Current event. Since you're already storing the rowsource in a database field, the code for this is really short:
Private Sub Form_Current
Laborer1.RowSource = ReferenceField.Value
Laborer1.Requery 'I don't believe you need this, but you might.
End Sub
I think I have an answer for continuous forms. When u click on combobox other combos turns blank but when u select everything looks normal.
I worked with my tables so sorry for a different example.. Anyway I think It is an answer..
I have 2 combobox and when u select the country the city combo shows only the selected Country's Cities.
This code is for Country Combo
Private Sub Country_Change()
Dim dbs As DAO.Database
Dim rsTable As DAO.Recordset
Dim rsQuery As DAO.Recordset
Set dbs = CurrentDb
'Open a table-type Recordset
Set rsTable = dbs.OpenRecordset("Cities", dbOpenTable)
'Open a dynaset-type Recordset using a saved query
Set rsQuery = dbs.OpenRecordset("Select * FROM Cities WHERE Country='" + Country + "'", dbOpenDynaset)
'We created a recordset filtered and set it to city.recordset
Set city.Recordset = rsQuery
city.Requery
End Sub
And this 2 sub is for City Combo..
Private Sub City_Change()
Dim dbs As DAO.Database
Dim rsTable As DAO.Recordset
Dim rsQuery As DAO.Recordset
Set dbs = CurrentDb
'Open a table-type Recordset
Set rsTable = dbs.OpenRecordset("Cities", dbOpenTable)
'Open a dynaset-type Recordset using a saved query
Set rsQuery = dbs.OpenRecordset("Select * FROM Cities", dbOpenDynaset)
Set city.Recordset = rsQuery
'We created a recordset NOT filtered and set it to city.recordset and after that we focus on a different control to be sure that our city combobox work correctly
city.Requery
Kimlik.SetFocus
End Sub
Private Sub City_Click()
Dim dbs As DAO.Database
Dim rsTable As DAO.Recordset
Dim rsQuery As DAO.Recordset
Set dbs = CurrentDb
'Open a table-type Recordset
Set rsTable = dbs.OpenRecordset("Cities", dbOpenTable)
'Open a dynaset-type Recordset using a saved query
Set rsQuery = dbs.OpenRecordset("Select * FROM Cities WHERE Country='" + Country + "'", dbOpenDynaset)
'We created a recordset filtered and set it to city.recordset
Set city.Recordset = rsQuery
city.Requery
End Sub
And here is my Access file

Access VBA: Put values of a multi-select list box into a Table

I have a list box where I can select Monday- Friday. I can select as many days as I want in the list box, all of them if I wanted. I want to know how to insert the value of the listbox into my table.
Here's the code I've written so far:
Private Sub Command499_Click()
Set RstRecSet = Nothing
Set db = CurrentDb
Dim dateDay As String
Dim dateWeek As String
MsgBox (lstDateDay.Selected)
''dateWeek = lstDateWeek.Value
db.Execute " INSERT INTO tblContacts (DateDay, DateWeek)Values" & "('" & dateDay & "', '" & dateWeek & "');"
db.Close
End Sub
As you can see I've been trying a lot of different things. My problem is getting the value of the list box; it keeps showing as null even though it has data selected. The exact error I'm getting is:
"Invalid use of Null."
EDIT:
Set rs = db.OpenRecordset("tblContacts")
For Each itm In lstDateWeek.ItemsSelected
rs.AddNew
rs!dateWeek = lstDateWeek.ItemData(itm)
rs!dateDay = itm
rs.Update
Next
rs.Close
Set rs = Nothing
Set db = Nothing
dateDay and dateWeek are columns in tblContacts.
You need to use the ItemsSelected collection to get the index of the selected items in the Multi Select list box and then iterate through them and use the index to reference the rows stored in the ItemData collection. As part of this iteration simply create a record set and add the fields and update. There are different ways to handle this part but I like this one shown below.
To use my sample, simply create a table called tblTest and two columns Description (text) and Day as a number.
Create a form and add a multi-select list box named DaysOfWeek. fill it in with the days of the week as a ValueList and then add a button which I labeled Store.
Paste the following code into the buttons click event and try it
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblTest")
For Each itm In DaysOfWeek.ItemsSelected
rs.AddNew
rs!Description = DaysOfWeek.ItemData(itm)
rs!Day = itm
rs.Update
Next
rs.Close
Set rs = Nothing
Set db = Nothing
My event procedure looks like this:
Private Sub Command19_Click()
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblTest")
For Each itm In DaysOfWeek.ItemsSelected
rs.AddNew
rs!Description = DaysOfWeek.ItemData(itm)
rs!Day = itm
rs.Update
Next
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
This could be done with an ADO call by building a SELECT string for your INSERT statement as well but for me this is straightforward.. If you have any questions let me know. If I can figure out how to attach my sample database I will.

MS Access Populating Continous form Sub-form via parameterized query dynamically

I am working on an application that should allow user select a code from a list box, and this value should be passed as a parameter to a sub-form(continuous) which is tied to an SQL Query to populate the form with values returned from the query.
How do I tie the listbox on the parent form to the continuous form (child form) in such a way that a change in the listbox is registered in the subform and it(child form) is re-populated accordingly?
The code below is what I currently have in my Parent form to trigger the change in the subform. But I am still missing the bit where I trigger the reloading of the information in the subform with this.
storedproc
SELECT tblACCOUNT.ACCOUNT_LABEL, tblACCOUNTValue.[ACCOUNTVALUE_VALUE]
FROM ((tblUPS INNER JOIN tblProductUPS ON tblProductUPS.[PRODUCTUPS_UPS] = tblUPS.[UPS_CODE]) INNER JOIN tblACCOUNT ON tblUPS.UPS_ID = tblACCOUNT.ACCOUNT_UPSID) INNER JOIN tblACCOUNTValue ON tblACCOUNTVALUE.[ACCOUNTVALUE_ACCOUNTID]= tblACCOUNT.[ACCOUNT_ID]
WHERE TBLPRODUCTUPS.[PRODUCTUPS_PRODUCTID] = (SELECT tblProductLevel.[PRODUCTLEVEL_ID]
FROM tblProductLevel WHERE tblProductLevel.[PRODUCTLEVEL_Code] IN ( [UPSIDS])
);
This is a field in my sub-form which I would like to tie to my query as source of parameter for the query.
Public Property Let qString(unstring As String)
If Not IsNull(unstring) And Len(unstring) > 0 Then
Currentstring = unstring
End If
End Property
The code below is code in my parent form I test connects directly to the Query that I created and passes the parameter directly to the query. However, since my sub-form is itself tied to the query, I need a way to get to the subform query and pass the information I need passed and invoke an update on the form afterwards.
Private Sub LoadSubform(unspscstring As String)
On Error GoTo Err_LoadSubform_Change
Dim dbs As Database
Dim strSQL As String
Dim strSelect As String
Dim strQueryName As String
Dim qryDef As QueryDef
Dim rst As Recordset
Dim prmOne As DAO.Parameter
Set dbs = CurrentDb
'then we'll open up the query:
Set qryDef = dbs.QueryDefs("spgetAttributeByUNSPSC")
'Now we'll assign values to the query using the parameters option:
'link your DAP.Parameters to the query
'Set prmOne = qryDef.Parameters!param_one
'prmOne = unspscstring
qryDef.Parameters(0) = unspscstring
'Now need to somehow trigger an update on the subform
'Close all objects
rst.Close
qryDef.Close
Set rst = Nothing
Set qryDef = Nothing
Bye_LoadSubform_Change:
Exit Sub
Err_LoadSubform_Change:
Beep: MsgBox Error$, 16, "Select Failed"
Resume Bye_LoadSubform_Change
End Sub
As long as the listbox allows only one item, you can use the link child and master fields of the subform to do this.
Link Child Fields: ID; ListFieldMatch
Link Master Fields : ID; MyListBox
Alternatively, you can set the Record Source of the form object of the subform control in VBA:
sSQL = "SELECT ID,Stuff FROM Table WHERE ID=" & Me.MyNumericListBox
Me.MySubformControlName.Form.RecordSource = sSQL
sSQL = "SELECT ID,Stuff FROM Table WHERE ID=" & Me.MyNumericListBox
Me.MySubformControlName.Form.RecordSource = sSQL
gives an error 2467 runtime error
"The expression you entered refers to an object that is closed or does'nt exist.