Related
Does MS Access allow to get the recordsource value of the form without opening the form itself? I'm trying to optimize my code as of now, what I did is I just hide the form then get the Recordsource form query but it takes time to load since some of the forms trigger a code upon onload.
I'm late to the game here - I sometimes post answers months or years after the original question was posted, as I post my own solutions when a quick search of the 'Stack finds questions relevant to my own problem of the day, but no answers that I can actually use.
[UPDATE, 06 June 2016]
The 'NameMap' property is not available in document objects from Access 2010 onwards. However, 'Stacker Thunderframe has pointed out that this is now available in the 'MsysNameMap' table.
I have amended the code, and this works in Access 2010 and 2013.
[/UPDATE]
Most of a form's properties are only available when the form is open, but some are available in the form's entry in the DAO Documents collection.
The DAO 'document' is a horrible object: it won't persist in memory and you have to refer to it explicitly every time you use it:
FormName = "MyForm"
For i = 0 To Application.CodeDb.Containers("Forms").Documents(FormName).Properties.Count - 1
Debug.Print i & vbTab & Application.CodeDb.Containers("Forms").Documents(FormName).Properties(i).Name & vbTab & vbTab & Application.CodeDb.Containers("Forms").Documents(FormName).Properties(i).Value
Next
Run that snippet for your form, and you'll see a 'NameMap' property that contains a list of the form's controls, and some of the form's properties.
...In a truly horrible format which needs a binary parser. You might want to stop reading and take an aspirin, right now, before continuing.
Health Warnings:
The NameMap Property is undocumented. It is therefore unsupported and there is no guarantee that this solution will work in future versions of Microsoft Access.
The solution in my code below will stop working if the NameMap's two-byte binary label for a Record Source ever changes, or if it's locale-specific.
This is a horrible hack: I accept no liability for any effects on your sanity.
OK, here's the code:
A VBA function to return the Record Source from a closed MS-Access form:
Private Function FormRecordSource_FromNameMap(FormName As String) As String
' Reads the Record Source from the NameMap Property of the Document object for the form.
' WARNING: there is a potential error here: if the form's RecordSource property is blank
' and it has one or more list controls with a .RecordSource property populating
' the list, this function will return the first list control's Record Source.
' This won't work if you're using non-ASCII characters (Char > 255) in your form name.
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim arrByte() As Byte
Dim strOut As String
If Application.Version < 12 Then
arrByte = Application.CodeDb.Containers("Forms").Documents(FormName).Properties("NameMap").Value
For i = 1 To UBound(arrByte) - 2 Step 2
' 2-byte marker for a querydef in the NameMap:
If (arrByte(i) = 228 And arrByte(i + 1) = 64) Then
j = i + 2
Do While arrByte(j) = 0 And arrByte(j + 1) = 0 And j < UBound(arrByte)
' loop through the null chars between the marker and the start of the string
j = j + 2
Loop
strOut = ""
Do Until (arrByte(j) = 0 And arrByte(j + 1) = 0) Or j >= UBound(arrByte) - 2
If arrByte(j) = 0 Then j = j + 1
' loop until we reach the null char which terminates this string
' appending the Bchars (not unicode Wchars!) of the table or query
strOut = strOut & Chr(arrByte(j))
j = j + 2
Loop
Exit For ' we only want the first datasource
End If
Next i
Else
arrByte = Nz(DLookup("[NameMap]", "[MSYSNameMap]", "[Name] = '" & FormName & "'"), vbNullChar)
If UBound(arrByte) < 4 Then Exit Function
strOut = ""
For j = 60 To UBound(arrByte) - 2 Step 2
If arrByte(j) = 0 And arrByte(j + 1) = 0 Then Exit For
strOut = strOut & Chr(arrByte(j))
Next j
End If
frmRecordSource_FromNameMap = strOut
Erase arrByte
End Function
If you use the RecordSource in (say) OpenRecordset or a DCOUNT function, I would advise you to encapsulate it in square brackets: you might get the name of a hidden query object saved from a 'SELECT' statement in the RecordSource, and that name will contain '~' tilde characters which need special handling.
And now, something extra that you didn't ask for, but other people will be looking for if they Googled their way here for 'MS Access RecordSource for a closed form':
Getting an MS-Access form's RecordSource, whether it's open or not
Most times, your form will be open. Problem is, you don't know that... And if it's a subform, it might not be visible in the Forms() collection. Worse, a form that's hosted as a subform might exist as multiple instances in several open forms.
Good luck with that, if you're looking to extract dynamic properties... Like filters, or the Record Source if it's set 'on the fly' by VBA.
Public Function GetForm(FormName As String, Optional ParentName As String = "") As Form
' Returns a form object, if a form with a name like FormName is open
' FormName can include wildcards.
' Returns Nothing if no matching form is open.
' Enumerates subforms in open forms, and returns the subform .form object if
' it has a matching name. Note that a form may be open as multiple instances
' if more than one subform hosts it; the function returns the first matching
' instance. Specify the named parent form (or the subform control's name) if
' you need to avoid an error arising from multiple instances of the form.
Dim objForm As Access.Form
If ParentName = "" Then
For Each objForm In Forms
If objForm.Name Like FormName Then
Set GetForm = objForm
Exit Function
End If
Next
End If
If GetForm Is Nothing Then
For Each objForm In Forms
Set GetForm = SearchSubForms(objForm, FormName, ParentName)
If Not GetForm Is Nothing Then
Exit For
End If
Next
End If
End Function
Private Function SearchSubForms(objForm As Access.Form, SubFormName As String, Optional ParentName As String = "") As Form
' Returns a Form object with a name like SubFormName, if the named object SubFormName is subform
' of an open form , or can be recursively enumerated as the subform of an open subform.
' This function returns the first matching Form: note that a form can be instantiated in multiple
' instances if it is used by more than one subform control.
Dim objCtrl As Control
For Each objCtrl In objForm
If TypeName(objCtrl) = "SubForm" Then
If objCtrl.Form.Name Like SubFormName Then
If ParentName = "" Or objForm.Name Like ParentName Or objCtrl.Name Like ParentName Then
Set SearchSubForms = objCtrl.Form
Exit For
End If
Else
Set SearchSubForms = SearchSubForms(objCtrl.Form, SubFormName, ParentName)
If Not SearchSubForms Is Nothing Then
Exit For
End If
End If
End If
Next objCtrl
End Function
Public Function FormRecordSource(FormName As String, Optional ParentName As String = "") As String
' Returns the Recordsource for a form, even if it isn't open in the Forms() collection
' This will look for open forms first. If you're looking for a subform, you may need a
' parent name for the form which hosts the subform: your named form might be open as a
' subform instance in more than one parent form.
' WARNING: there is a potential error here: if the form isn't open, and it has a blank
' RecordSource property, and it has one or more controls with a .RecordSource
' property populating a list, a list control's RecordSource could be returned
Dim objForm As Form
If FormName = "" Then
Exit Function
End If
Set objForm = GetForm(FormName, ParentName)
If objForm Is Nothing Then
FormRecordSource = FormRecordSource_FromNameMap(FormName)
Else
FormRecordSource = objForm.RecordSource
Set objForm = Nothing
End If
End Function
Share and enjoy: and please accept my apologies for any unwanted line breaks in the code sample.
One option would be to save the Record Source of the form as a Query. Say you have a form named [AgentForm] whose Record Source is
SELECT ID, AgentName FROM Agents
In your development .accdb copy of the database, open the form in Design View and open the Record Source in the Query Builder. Click the "Save As" button ...
and save the query as "AgentForm_RecordSource". Now the Record Source property of the form is just a reference to the saved query, and the query itself can be accessed directly through a QueryDef object. So, you could retrieve the SQL statement for the form's Record Source with
Dim cdb As DAO.Database, qdf As DAO.QueryDef, sql As String
Set cdb = CurrentDb
Set qdf = cdb.QueryDefs("AgentForm_RecordSource")
sql = qdf.SQL
or you could go ahead and open a Recordset with
Dim cdb As DAO.Database, qdf As DAO.QueryDef, rst As DAO.Recordset
Set cdb = CurrentDb
Set qdf = cdb.QueryDefs("AgentForm_RecordSource")
Set rst = qdf.OpenRecordset
If the form's Record Source is a SELECT statement rather than the name of a table or saved query, you can check the QueryDefs collection for the hidden QueryDef which Access created for that Record Source statement.
If it exists, you can check its .SQL property.
strFormName = "Form15"
? CurrentDb.QueryDefs("~sq_f" & strFormName).SQL
SELECT DISTINCTROW *
FROM [DB Audits];
You can trap error #3265, "Item not found in this collection", which will be thrown if that QueryDef does not exist.
Since you can't open your form in design view and opening your form regularly is causing performance issues, there are but a few more workarounds:
Depending on how you want to check for the closed form's recordsource, you can set a global variable in the following way, in a separate module:
Public glb_getrecordsource As String
Afterwards, depending on how you call the code, you can do the following:
Private Sub Command1_Click()
glb_getrecordsource = "Yes"
DoCmd.OpenForm "Form1"
'... Do something
End Sub
Then, as the final step, put the following at the beginning of your form's OnLoad event:
Private Sub Form_Load()
If glb_getrecordsource = "Yes" Then
glb_getrecordsource = Me.Form.RecordSource
DoCmd.Close acForm, "Form1", acSaveYes
Exit Sub
End If
'... Usual OnLoad events
End Sub
This will at least solve the performance issues, since you will not trigger any of the time consuming events, in the form's load event.
Another workaround:
You can export your form to a .txt file and then search the text file for the recordsource. The following code will export your forms to .txt files in a specified folder:
Dim db As Database
Dim d As Document
Dim c As Container
Dim sExportLocation As String
Set db = CurrentDb()
sExportLocation = "C:\AD\" 'Do not forget the closing back slash! ie: C:\Temp\
Set c = db.Containers("Forms")
For Each d In c.Documents
Application.SaveAsText acForm, d.Name, sExportLocation & "Form_" & d.Name & ".txt"
Next d
Code partly borrowed from this forum. Afterwards, you only have to open the file and search for the recordsource. If the recordsource is empty it will not be exported, so keep that in mind. Also, I doubt this will improve perfomance, but who knows!
I have a form with a subform. The subform is a continuous form so I can use conditional formatting. Using controls in a Tab Control, the values of the currently selected record on the subform are changed. So, I requery the subform to update the subform continuous form to show the updated data.
I can get the correct record re-selected in the subform, but the position of that record in the list jumps to the top of the subform's list instead of maintaining the position it was in prior to the update.
I have tried playing with the CurrentSectionTop values of the subform, but I am not able to correctly maintain the user's selection position within the subform after requerying the subform.
Is there some way to get the current position of the subform's continuous form's scrollbar position and then set that position in code after the continuous form is requeried? (Stephen Lebans' code for doing this (see: http://www.lebans.com/SelectRow.htm) does not work for me because I'm using Access 2013 and his code won't convert to Access 2013).
Here's a sample of what the subform continuous form display might look like to begin with while Record 7 is the current record selected:
{start of continuous form view}
[ ] Record 3 in continuous form view
[ ] Record 4 in continuous form view
[ ] Record 5 in continuous form view
[ ] Record 6 in continuous form view
[>] Record 7 in continuous form view
[ ] Record 8 in continuous form view
[ ] Record 9 in continuous form view
{end of continuous form view}
{tab control displays down here below the continuous form subform}
After the subform is requeried, here is what the subform continuous form display looks like, but I want the display to look the same as above; the display should not put Record 7 as the top record in the continuous form view since it was the 5th record down in the view originally so I want it to be the 5th record down after the requery:
{start of continuous form view}
[>] Record 7 in continuous form view
[ ] Record 8 in continuous form view
[ ] Record 9 in continuous form view
[ ] Record 10 in continuous form view
[ ] Record 11 in continuous form view
[ ] Record 12 in continuous form view
[ ] Record 13 in continuous form view
{end of continuous form view}
{tab control displays down here below the continuous form subform}
I couldn't get Wayne G Dunn's solution working, but I came up with this alternative. It's not wonderful, but it worked for me.
The basic idea is that each record in the continuous form has a position (ie top record showing on the screen is in position 1, regardless which actual record it is). You have a table that relates those positions, to the Form.currentSectionTop property of each record in the form, so you can figure out what position the current record is in. Then it's relatively straightforward to return to that position after the requery.
Create the table with the positions - this needs to run on startup or somewhere - might need to be more frequent if the user can resize or anything might change the number of records that could be shown in the continuous form.
Public Sub Setup_Positions()
Dim sql As String
Dim Position As Long
Dim currentSectionTop As Long
Dim lastSectionTop As Long
sql = "DELETE FROM tblRecordPosition"
currentdb.execute sql
DoCmd.GoToRecord , , acFirst
Position = 1
Call Set_NoUpdate
With Forms("frmMain").Controls("frmContinuousSubForm").Form
currentSectionTop = .currentSectionTop
Do While currentSectionTop <> lastSectionTop
'record previous sectiontop
lastSectionTop = currentSectionTop
'write it into the table
sql = "INSERT INTO tblRecordPosition (Position, CurrentSectionTop) " & _
"SELECT " & Position & ", " & _
currentSectionTop
CurrentDb.Execute sql
'update to next position and record the 'last' one, move to next record. When we've run out of visible ones, the last and current will be the same.
Position = Position + 1
DoCmd.GoToRecord , , acNext
'get new current sectiontop
currentSectionTop = .currentSectionTop
Loop
End With
Call Set_NoUpdateOff
End Sub
Set up global variables and a couple of functions to maintain them. The 'NoUpdateRequired' variable is optional - I use it to prevent unnecessary stuff running all the time.
Public NoUpdateRequired As Boolean
Public Position As Long
Public Sub Set_NoUpdate()
NoUpdateRequired = True
End Sub
Public Sub Set_NoUpdateOff()
NoUpdateRequired = False
End Sub
Create this function to convert between the property you can measure, and the actual position:
Public Function Get_Position(Optional InputCurrentSectionTop As Long) As Long
Dim currentSectionTop As Long
Dim Position As Long
If InputCurrentSectionTop > 0 Then
currentSectionTop = InputCurrentSectionTop
Else
currentSectionTop = Forms("frmMain").Controls("frmContinuousSubForm").Form.currentSectionTop
End If
Position = Nz(ELookup("Position", "tblRecordPosition", "CurrentSectionTop = " & currentSectionTop), 0)
Get_Position = Position
End Function
In the current event of the continuous form, you need this:
Private Sub Form_Current()
If NoUpdateRequired = False Then
Position = Get_Position
End If
End Sub
And finally, in the bit where you want your refresh to happen, you need this:
Public Sub Refresh_ContinuousSubForm()
'All this problem goes away if you can use Refresh instead of Requery, but if you have a few things editting the underlying table, you must use requery to avoid 'another user has changed the data' errors.
'However, this then causes the form to jump
'back to the first record instead of keeping the current record selected. To get around this, the following has been employed:
'the .seltop property allows you to select the top selected record (in most cases, only one record is selected). This is recorded before the refresh, and
'the form set back to that after the refresh. However, this puts the selected record at the top of the screen - confusing when you're working down a list.
'The .currentSectionTop property measures the number of twips from the selected record to the top of the screen - and correlates to which position in the list
'of 25 records in the bottom pane. tblRecordPosition converts between the twips to the actual position (recorded when the database is opened).
'The key to all this is that going back to the right record using .seltop only puts the record at the top of the screen IF the record wasn't already visible on the screen.
'But GoToRecord, if used when you're already at the top of the screen, will push the records down the screen as you move backward (upward) through them.
'So we go to the right record, and it will probably be at the top of the screen because of the requery. Then we push them down the screen back to the original position
'using GoToRecord, but now we're on the wrong record. Then we return to the right record using .seltop, and because it's already on the screen, it won't move position.
Dim startSeltop As Long
Dim newSectionTop As Long
Dim newPosition As Long
Dim startPosition As Long
Dim recordsToMove As Long
'Also global variable Position (long) which is recorded in the form's current event
Call Set_NoUpdate
startPosition = Position
With Forms("frmMain").Controls("frmContinuousSubForm").Form
.Painting = False 'stops the screen flickering between
startSeltop = .SelTop 'records which record we're on. Position represents where that was showing on the screen.
.Requery 'does the requery
.SelTop = startSeltop 'sets us back to the correct record
newSectionTop = .currentSectionTop 'measures in twips which position it's in (usually 1)
newPosition = Get_Position(newSectionTop) 'converts that to the position
recordsToMove = startPosition - newPosition 'calculates how many records to move - moving records using GoToRecord moves the position as well
If recordsToMove > 0 Then
DoCmd.GoToRecord , , acPrevious, recordsToMove 'moves back enough records to push our record to the right place on the screen
End If
.SelTop = startSeltop 'now sets back to the correct record
.Painting = True 'turns the screen painting back on
End With
Call Set_NoUpdateOff
End Sub
The following code is a subset of the code found on Stephen Lebans' website: http://www.lebans.com/SelectRow.htm . That link has a link to a zipped version of an Access database with all the code to handle multiple scenarios, however the database is an older version and needs to be converted. Mr Leban's code does far more than what is included here, but I am only using this code to solve one specific issue.
(A) Create a Class Module named 'clsSetRow' and paste in the following code:
Option Compare Database
Option Explicit
Private mSelTop As Long
Private mCurrentSectionTop As Long
Public Property Get SelTop() As Long
SelTop = mSelTop
End Property
Public Property Let SelTop(x As Long)
mSelTop = x
End Property
Public Property Get CurrentSectionTop() As Long
CurrentSectionTop = mCurrentSectionTop
End Property
Public Property Let CurrentSectionTop(x As Long)
mCurrentSectionTop = x
End Property
(B) In your module for your form, include the following at the top:
Private SR As clsSetRow
Dim lCurRec As Long
(C) Add the following Event Handlers and code:
Private Sub Form_Load()
Set SR = New clsSetRow
End Sub
Private Sub Form_Current()
' This event can be called during the Form Load event prior to the init of
' our class so we must test for this.
If Not SR Is Nothing Then
SR.SelTop = Me.SelTop
SR.CurrentSectionTop = Me.CurrentSectionTop
End If
End Sub
Private Sub Form_AfterInsert() ' OR JUST USE THE BEFOREINSERT
lCurRec = Me.CurrentRecord
'Debug.Print "After Insert, Current: " & Me.CurrentRecord
End Sub
Private Sub Form_BeforeInsert(Cancel As Integer) ' OR JUST USE THE AFTERINSERT
lCurRec = Me.CurrentRecord
'Debug.Print "Before Insert, Current: " & Me.CurrentRecord
End Sub
(D) Wherever you want to reposition (i.e. after a REQUERY), add the following line of code:
DoCmd.GoToRecord acDataForm, Me.Name, acGoTo, lCurRec
(E) To test this, just add a command button that will 'Requery and then GoToRecord'.
NOTE: Simply scrolling up or down using the scrollbar will NOT save the row of where you are! You need to establish a 'current record' for this to reposition.
Good Luck! And thank you Stephen Lebans for the code!
I'm in the process of converting an Access Data Project (ADP) into a standard ACCDB format with ODBC linked tables. In the ADP, I had overridden the Refresh button to return the user to the current record by using the following code:
Public Sub RibbonCmd_RefreshScreen(ctl As IRibbonControl, ByRef cancelDefault)
On Error GoTo ErrHandler
cancelDefault = False
DoCmd.Echo False
Dim saveBookmark
With Screen.ActiveForm
saveBookmark = .Bookmark
.Requery
.Bookmark = saveBookmark
End With
'Success - cancel the default behavior
cancelDefault = True
ExitHandler:
DoCmd.Echo True
Exit Sub
ErrHandler:
cancelDefault = False
Resume ExitHandler
End Sub
My understanding is that this should work just fine with DAO, but I get error 3159, Not a valid bookmark. I've also tried replacing .Bookmark with .Recordset.Bookmark, but that gave me the same result. Is there something I'm doing wrong here?
Actually, a requery of a form or a requery of a recordset will re-set and invalidate book marks.
So such book marks are no longer valid after a requery.
So the best approach here will depend on either
a) I simply want to re-display any changed records (and not move off current record).
b) I simply want to re-display any changed records AND ALSO display new records (the new records is the critical part).
If you just need a refresh, then you can use the appropriately called command refresh.
Eg:
Me.Refresh
Or in your case
Screen.ActiveForm.Refresh
So the above is ONE line of code and is ALL you need. The current record pointer for the form does NOT change when you use this command. All and any record changed will re-display for you.
Note that since you can behind the form button use:
Me.Refresh
Then LITTLE need is required to call a general routine as you have written.
However, if you need the form to "load" or display any new records added, then you DO have to use requery. In this case as noted book marks in this case all become invalid.
So, for code to requery, then we use the PK value (and hopefully you used the default pk of ID that been the default for 20 years). The code would then become:
Dim lngID As Long
If IsNull(Me!ID) Then Exit Sub
lngID = Me!ID
Me.Requery
Me.Recordset.FindFirst "id = " & lngID
Now of course if the PK id is not the same for each form, then you most certainly could pass the NAME of the PK value to your "general" refresh routine. It would look like:
Public Sub MyRefresh(strPK As String)
Dim lngID As Long
If IsNull(Me(strPK)) Then Exit Sub
lngID = Me(strPK)
Me.Requery
Me.Recordset.FindFirst strPK & " = " & lngID
End Sub
The "hope" here is you actually really JUST need refresh, since as noted this is only one line of code, and better yet it does NOT move the record pointer.
I use VB6 and Visual Data Manager in development. I have had the same problem. Most probably it arose when 2 users tried to update the same record in the same time. So some fields in the table are corrupted.
Here are the steps I used to solve the problem:
1- Copy the structure of the table (lets call it table1)to another table (lets call it table2).
2- Find the correpted record(s) in table1.
3- Transfer the data from table1 to table2 except the corrupted record(s)
4- Reenter the excluded record(s) to table2 again.
5- Rename table1 table3
6- Rename table2 table1
That's all folk
abdobox#yahoo.com
I have used the forms Recordset.AbsolutePosition, and this works fine e.g. in the OnKeyDown exit of a field
Dim PrefilterPosition As Long
Private Sub ValnSubject_KeyDown(KeyCode As Integer, Shift As Integer)
' Not F2 - exit
If KeyCode <> vbKeyF2 Then Exit Sub
' Get the active control
Dim ActiveCtl As Control
Set ActiveCtl = Me.ActiveControl
ActiveControlName = ActiveCtl.Name
' Is the form's filter set?
If Me.Filter = "" Then
' NO: Apply the new filter
' Note the current position in the recordset
PrefilterPosition = Me.Recordset.AbsolutePosition
' Set the filter to the Active control's value
Me.Filter = "[" & ActiveCtl.ControlSource & "]='" & ActiveCtl.Value & "'"
Me.FilterOn = Me.Filter <> ""
Me.Requery
Else
' YES: Clear the filter
Me.Filter = ""
Me.FilterOn = Me.Filter <> ""
Me.Requery
' Align the recordset on the previously stored position
Me.Recordset.AbsolutePosition = PrefilterPosition
End If
' Restore the cursor to where it came from
Me.Controls(ActiveControlName).SetFocus
Ex_it:
End Sub
For context: this code was from an idea for an 'Instant Filter', where you position the cursor on a field in a tab form, press F2, and then a filter is applied so you see only records with the selected field's value. Press F2 again and the filter is removed and the cursor goes back into the place it was when you hit F2 the first time. Bookmarks do not work here, as Albert says above.
I have a form which includes a data sheet. I would like to make it possible for a user to select multiple rows, click on a button and have some sql query run and perform some work on those rows.
Looking through my VBA code, I see how I can access the last selected record using the CurrentRecord property. Yet I don't see how I can know which rows were selected in a multiple selection. (I hope I'm clear...)
What's the standard way of doing this? Access VBA documentation is somewhat obscure on the net...
Thanks!
I used the technique similar to JohnFx
To trap the Selection height before it disappears I used the Exit event of the subform control in the Main form.
So in the Main form:
Private Sub MySubForm_Exit(Cancel As Integer)
With MySubForm.Form
m_SelNumRecs = .SelHeight
m_SelTopRec = .SelTop
m_CurrentRec = .CurrentRecord
End With
End Sub
Here is the code to do it, but there is a catch.
Private Sub Command1_Click()
Dim i As Long
Dim RS As Recordset
Dim F As Form
Set F = Me.sf.Form
Set RS = F.RecordsetClone
If F.SelHeight = 0 Then Exit Sub
' Move to the first selected record.
RS.Move F.SelTop - 1
For i = 1 To F.SelHeight
MsgBox RS![myfield]
RS.MoveNext
Next i
End Sub
Here's the catch:
If the code is added to a button, as soon as the user clicks that button, the selection is lost in the grid (selheight will be zero). So you need to capture that info and save it to a module level variable either with a timer or other events on the form.
Here is an article describing how to work around the catch in some detail.
http://www.mvps.org/access/forms/frm0033.htm
Catch 2: This only works with contiguous selections. They can't select mutliple non-sequential rows in the grid.
Update:
There might be a better event to trap this, but here is a working implementation using the form.timerinterval property that i have tested (at least in Access 2k3, but 2k7 should work just fine)
This code goes in the SUBFORM, use the property to get the selheight value in the master form.
Public m_save_selheight As Integer
Public Property Get save_selheight() As Integer
save_selheight = m_save_selheight
End Property
Private Sub Form_Open(Cancel As Integer)
Me.TimerInterval = 500
End Sub
Private Sub Form_Timer()
m_save_selheight = Me.selheight
End Sub
I've tried doing something like that before, but I never had any success with using a method that required the user to select multiple rows in the same style as a Windows File Dialog box (pressing Ctrl, Shift, etc.).
One method I've used is to use two list boxes. The user can double click on an item in the left list box or click a button when an item is selected, and it will move to the right list box.
Another option is to use a local table that is populated with your source data plus boolean values represented as checkboxes in a subform. After the user selects which data they want by clicking on checkboxes, the user presses a button (or some other event), at which time you go directly to the underlying table of data and query only those rows that were checked. I think this option is the best, though it requires a little bit of code to work properly.
Even in Access, I find sometimes it's easier to work with the tables and queries directly rather than trying to use the built-in tools in Access forms. Sometimes the built-in tools don't do exactly what you want.
A workaround to the selection loss when the sub form loses the focus is to save the selection in the Exit event (as already mentioned by others).
A nice addition is to restore it immediately, using timer, so that the user is still able to see the selection he made.
Note: If you want to use the selection in a button handler, the selection may not be restored already when it executes. Make sure to use the saved values from the variables or add a DoEvents at the beginning of the button handler to let the timer handler execute first.
Dim m_iOperSelLeft As Integer
Dim m_iSelTop As Integer
Dim m_iSelWidth As Integer
Dim m_iSelHeight As Integer
Private Sub MySubForm_Exit(Cancel As Integer)
m_iSelLeft = MySubForm.Form.SelLeft
m_iSelTop = MySubForm.Form.SelTop
m_iSelWidth = MySubForm.Form.SelWidth
m_iSelHeight = MySubForm.Form.SelHeight
TimerInterval = 1
End Sub
Private Sub Form_Timer()
TimerInterval = 0
MySubForm.Form.SelLeft = m_iSelLeft - 1
MySubForm.Form.SelTop = m_iSelTop
MySubForm.Form.SelWidth = m_iSelWidth
MySubForm.Form.SelHeight = m_iSelHeight
End Sub
There is another solution.
The code below will show the number of selected rows as soon as you release the mouse button.
Saving this value will do the trick.
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
MsgBox Me.SelHeight
End Sub
Use a Global variable in the form, then refer to that in the button code.
Dim g_numSelectedRecords as long
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
g_numSelectedRecords = Me.SelHeight
End Sub
Dim formRecords As DAO.Recordset
Dim i As Long
Set formRecords = Me.RecordsetClone
' Move to the first record in the recordset.
formRecords.MoveFirst
' Move to the first selected record.
formRecords.Move Me.SelTop - 1
For i = 1 To numSelectedRecords
formRecords.Edit
formRecords.Fields("Archived") = True
formRecords.Update
formRecords.MoveNext
Next i
Why not use an array or recordset and then every time the user clicks on a row (either contiguous or not, save that row or some identifier into the recordset. Then when they click the button on the parent form, simply iterate the recordset that was saved to do what you want. Just don't forget to clear the array or recordset after the button is clicked.?
Another workaround to keeping the selection while attempting to execute a procedure - Instead of leaving the datasheet to activate a button, just use the OnKeyDown event and define a specific keycode and shift combination to execute your code.
The code provided by JohnFx works well. I implemented it without a timer this way (MS-Access 2003):
1- Set the Form's Key Preview to Yes
2- put the code in a function
3- set the event OnKeyUp and OnMouseUp to call the function.
Option Compare Database
Option Explicit
Dim rowSelected() As String
Private Sub Form_Load()
'initialize array
ReDim rowSelected(0, 2)
End Sub
Private Sub Form_Current()
' if cursor place on a different record after a selection was made
' the selection is no longer valid
If "" <> rowSelected(0, 2) Then
If Me.Recordset.AbsolutePosition <> rowSelected(0, 2) Then
rowSelected(0, 0) = ""
rowSelected(0, 1) = ""
rowSelected(0, 2) = ""
End If
End If
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
rowsSelected
If KeyCode = vbKeyDelete And Me.SelHeight > 0 Then
removeRows
End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
rowsSelected
End Sub
Sub rowsSelected()
Dim i As Long, rs As DAO.Recordset, selH As Long, selT As Long
selH = Me.SelHeight
selT = Me.SelTop - 1
If selH = 0 Then
ReDim rowSelected(0, 2)
Exit Sub
Else
ReDim rowSelected(selH, 2)
rowSelected(0, 0) = selT
rowSelected(0, 1) = selH
rowSelected(0, 2) = Me.Recordset.AbsolutePosition ' for repositioning
Set rs = Me.RecordsetClone
rs.MoveFirst ' other key touched caused the pointer to shift
rs.Move selT
For i = 1 To selH
rowSelected(i, 0) = rs!PositionNumber
rowSelected(i, 1) = Nz(rs!CurrentMbr)
rowSelected(i, 2) = Nz(rs!FutureMbr)
rs.MoveNext
Next
Set rs = Nothing
Debug.Print selH & " rows selected starting at " & selT
End If
End Sub
Sub removeRows()
' remove rows in underlying table using collected criteria in rowSelected()
Me.Requery
' reposition cursor
End Sub
Private Sub cmdRemRows_Click()
If Val(rowSelected(0, 1)) > 0 Then
removeRows
Else
MsgBox "To remove row(s) select one or more sequential records using the record selector on the left side."
End If
End Sub
I am considering the use of a tab control on a parent form for which I would like to have around 20 tabs. Each tab I am considering the use of one or two separate sub forms. Each sub form will have varied complexity in coded logic. By taking this approach will I severally reduce the performance of my application? I am currently using this in MS Access 2003. I will expect an average of 15 users at any given time on the various forms.
Thoughts?
Yes, performance will be degraded slightly for each subform. One or three isn't too bad but twenty is definitely going to cause you performance issues.
Once you have the subform working to your satisfaction either save the Record Source as a query and give it a name or save the query SQL string. Then either paste the query name or the query SQL string in the VBA code in the tab control change event.
Private Sub TabCtl_Change()
On Error GoTo TabCtl_Change_Error
Select Case Me.TabCtl.Value
Case Me.pagPartsConsumed.PageIndex
If Me.PartsConsumedsbf.Form.RecordSource <> "Equipment - Parts Consumed sbf" Then _
Me.PartsConsumedsbf.Form.RecordSource = "Equipment - Parts Consumed sbf"
....
Now just to ensure that I don't accidentally leave some subform recordsources filled in slowing down the app on startup I check to see if the file the code is running is an MDB (instead of an MDE. The function is below) then display a message telling me I have to remove the recordsource.
If Not tt_IsThisAnMDE Then
If Me.PartsConsumedsbf.Form.RecordSource <> "" Then _
MsgBox "Record source of Equipment - Parts Consumed sbf not empty"
...
End If
Public Function tt_IsThisAnMDE()
On Error GoTo tagError
Dim dbs As Database
Set dbs = CurrentDb
Dim strMDE As String
On Error Resume Next
strMDE = dbs.Properties("MDE")
If Err = 0 And strMDE = "T" Then
' This is an MDE database.
tt_IsThisAnMDE = True
Else
tt_IsThisAnMDE = False
End If
Exit Function
tagError:
Call LogError(Application.CurrentObjectName, "")
Exit Function
End Function
Also in the form unload event I clear the Recourd Source as well.
Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Form_Unload_Error
Me.PartsConsumedsbf.Form.RecordSource = ""
....
BTW I almost always would put each subform on a seperate tab. Also that many tab entries gets visusally unwieldy. When I had a similar question my fellow Access MVPs suggested using a listbox along the left hand side to control which subform is viewable.
Also each combo box and list box will also slightly degrade the performance. So if you have those on a subform then consider similar logic.
In addition to adding recordsets at runtime, I would generally only use one or two tabs and a number of controls to load various subforms into a subform control.
The text for the On Click event of the control might be:
=WhichPage([Form],"lblLocations")
Where WhichPage is a function with the following lines, amongst others:
Function WhichPage(frm, Optional LabelName = "")
<..>
Select Case LabelName
Case "lblLocations"
frm("sfrmAll").SourceObject = "sfrmLocations"
<...>
If necessary, the link child and link master fields can be changed at runtime. The link master field is best set to the name of a control, rather than a field, to avoid errors.
Me.sfrmAll.LinkChildFields = "LocationKey"
Me.sfrmAll.LinkMasterFields = "txtLocationKey"
To expand on Remou's answer...here is a sub I wrote that dynamically loads a form into a subform control. You pass in the name of the form in the call and it will load it into the subform of the Main form. The arguments map to the arguments of Docmd.OpenForm method of Access. If the main form that is hosting the subform control is not open...it just does a regular open of the form. Otherwise it loads it into the subform control. If a where clause was passed in it is used to filter the subform.
Public Sub MyOpenForm(FormName As String, _
Optional View As AcFormView = acNormal, _
Optional FilterName As String = vbNullString, _
Optional WhereCondition As String = vbNullString, _
Optional DataMode As AcFormOpenDataMode, _
Optional WindowMode As AcWindowMode, _
Optional OpenArgs As String)
On Error GoTo PROC_ERR
Dim frm As Form
Dim strNewForm As String
Dim strCurrentForm As String
Dim strNewTable As String
Dim fDoNotFilter As Boolean
Dim strActionText As String
Dim strID As String
If Not IsLoaded("frmMain") Then
DoCmd.OpenForm FormName:=FormName, View:=View, FilterName:=FilterName, WhereCondition:=WhereCondition, DataMode:=DataMode, WindowMode:=WindowMode, OpenArgs:=OpenArgs
Else
strCurrentForm = Forms![frmMain]![sfrMyForm].SourceObject
If strCurrentForm <> FormName Then
Forms![frmMain]![sfrMyForm].SourceObject = vbNullString
Forms![frmMain]![sfrMyForm].SourceObject = FormName
End If
If WhereCondition <> vbNullString Then
Forms![frmMain]![sfrMyForm].Form.Filter = WhereCondition
Forms![frmMain]![sfrMyForm].Form.FilterOn = True
End If
End If
PROC_EXIT:
Exit Sub
PROC_ERR:
MsgBox Err.Description
Resume PROC_EXIT
End Sub