Problem with VBA created subform in Access 2007

[Robert A.]

I have just upgraded an Access 97 DB to 2007. In the DB I have a main form
that creates a subform in VBA when a selection is made in a combo box. This
form is used by our data entry personal. I have the subform set to
automatically jump to the next field when an answer is selected in a combo
box (this helps the data entry personal be very fast when entering surveys.)

Here is my problem when an answer is selected it stalls for a good 5 seconds
then jumps. Since the subform is created in VBA when a selection is made in
the main form I can not hard code the jumps. This method worked fine in 97
but in 2007 there seems to be an issue with it. Can anyone help me, or can
anyone see why its stalling?


Sub GoToNextControl()


Dim ctrl As Control
Dim frm As Form
Dim CtrlIndex As Integer
Dim Cnt As String


Set frm = Screen.ActiveForm![New Form].Form
Set ctrl = frm.ActiveControl
CtrlIndex = frm.ActiveControl.TabIndex
Cnt = (frm.Controls.Count / 2)


If ctrl.ControlType = acComboBox And CtrlIndex < Cnt - 1 Then
If ctrl.ListIndex <> -1 Then
frm.Controls.Item(CtrlIndex + 1).SetFocus
End If
End If


End Sub

We have upgraded our computers and are having issues with Windows XP
and Office 97. I need to get this working. I am hoping one of you gurus out
there can tell me what I am doing wrong as I do not have much experience.

Thanks for your time!

 

[Dirk Goldgar]

In

I have just upgraded an Access 97 DB to 2007. In the DB I have a main
form that creates a subform in VBA when a selection is made in a
combo box. This form is used by our data entry personal. I have the
subform set to automatically jump to the next field when an answer is
selected in a combo box (this helps the data entry personal be very
fast when entering surveys.)

Here is my problem when an answer is selected it stalls for a good 5
seconds then jumps. Since the subform is created in VBA when a
selection is made in the main form I can not hard code the jumps.
This method worked fine in 97 but in 2007 there seems to be an issue
with it. Can anyone help me, or can anyone see why its stalling?


Sub GoToNextControl()


Dim ctrl As Control
Dim frm As Form
Dim CtrlIndex As Integer
Dim Cnt As String


Set frm = Screen.ActiveForm![New Form].Form
Set ctrl = frm.ActiveControl
CtrlIndex = frm.ActiveControl.TabIndex
Cnt = (frm.Controls.Count / 2)


If ctrl.ControlType = acComboBox And CtrlIndex < Cnt - 1 Then
If ctrl.ListIndex <> -1 Then
frm.Controls.Item(CtrlIndex + 1).SetFocus
End If
End If


End Sub

We have upgraded our computers and are having issues with Windows XP
and Office 97. I need to get this working. I am hoping one of you
gurus out there can tell me what I am doing wrong as I do not have
much experience.

Thanks for your time!

What do you mean when you say the main form "creates a subform in VBA"?
Are actually creating a new subform control at runtime? Or do you mean
that you are creating a new record in an existing subform?

 

[Robert A.]

What do you mean when you say the main form "creates a subform in VBA"?
Are actually creating a new subform control at runtime? Or do you mean
that you are creating a new record in an existing subform?

--
Dirk Goldgar, MS Access MVP
www.datagnostics.com

(please reply to the newsgroup)

When you select a item from a combo Box on the main form, VBA then goes out
to several tables and creates a brand new subform based on the selection. So
to answer you question it creates a new subform control at runtime.

It was done this way so a new form would not have to be created when new
surveys were added. You just add the questions to one table, add the possible
answers to another table, and the question set identifier to a third table,
then add the question set defaults to the code. The combo box on the main
form lists the question set identifer and when you select one, the code
creates the subform from the other tables.

Hope that answers your question, do you think you can help me?

 

[Evy Leach]

I'm with Dirk. I don't understand how you are "creating a subform in VBA".
I've never seen that before. It would be interesting to see your code.

leach613

 

[Robert A.]

Evy Your wish is my command

Know that this is the code to create the form the Logic is to large to post
here.

Private Sub Combo82_AfterUpdate()
Application.VBE.MainWindow.Visible = False
Dim qsid As String
Dim rs As Recordset
Dim dbs As Database
Dim sql As String
Dim rcnt As Integer
Dim ctrl As Control
'Needed to dynamically create Q & A controls to allow text fields or
combo boxes
Dim frmOldForm As Form
Dim frmNewForm As Form
Dim strFormName As String, colwid As String
Dim ctlLabel As Control, ctlText As Control, Ctrldc As Control
Dim intDataX As Integer, intDataY As Integer
Dim intLabelX As Integer, intLabelY As Integer
Dim intLabelW As Integer, intLabelH As Integer
Dim X As Integer, questX As Integer, answerX As Integer
Dim cntrltype As String
Dim strSrchCrit As String
Dim strFormat As String
'Needed to dynamically create code module
Dim strDCAutoAns As String
Dim DCmdl As Module
Variables to dynamically create code module to refer to System Edits
Dim strWaltSEreference As String
Dim Waltmdl As Module
Dim lngReturn As Long
Me.ch_Signature.value = False 'Added to clear no signature box
Me.Spouse.value = False 'Added to clear spouse box

Me.New_Form.SourceObject = "aBaseForm"
'This retrieves all the questions available to the selected Question set
in the Combo82 combo box -
'the recordset is ordered by the quest_id field (ascending which is the
default)
Set dbs = CurrentDb
sql = "select quest_id, quest_text, answertype, format from questions
where question_set_id = '" & qsid & "' order by 1"
Set rs = dbs.OpenRecordset(sql)
If rs.EOF = True Then
MsgBox ("There are no questions in the selected question set.")
Exit Sub
End If
rs.MoveLast
rcnt = rs.RecordCount
ReDim NameArray(rcnt)
rs.MoveFirst

'The answertype field is either "T" for textboxes or "D" for combo boxes
and this field is placed into -
'an array in the order the recordset was created: by the question_id field

For X = 1 To rcnt
If Not rs.EOF Then
NameArray(X) = rs.Fields("answertype")
rs.MoveNext
End If
Next X
'Creates new sub-form
Set frmNewForm = CreateForm()
'Sets label Dimensions
intLabelW = 3750
intLabelH = 250
'Creates First Half Answers fields
For X = 1 To (Int(rcnt / 2))
' Set positioning values for new controls.
intDataX = 3900
intDataY = 100 * (4 * X) - 90
cntrltype = NameArray(X)
If cntrltype = "T" Then
' Create unbound default-size text box in detail section.
Set ctlText = CreateControl(frmNewForm.Name, acTextBox, , "",
"", intDataX, intDataY)
ElseIf cntrltype = "D" Then
Set ctlText = CreateControl(frmNewForm.Name, acComboBox, , "",
"", intDataX, intDataY)
End If
Next X
'Creates Next Half of Answer fields
For X = (Int(rcnt / 2) + 1) To rcnt
' Set positioning values for new controls.
intDataX = 9500
intDataY = 100 * (4 * (X - (Int(rcnt / 2)))) - 90
cntrltype = NameArray(X)

If cntrltype = "T" Then
' Create unbound default-size text box in detail section.
Set ctlText = CreateControl(frmNewForm.Name, acTextBox, , "",
"", intDataX, intDataY)
ElseIf cntrltype = "D" Then
Set ctlText = CreateControl(frmNewForm.Name, acComboBox, , "",
"", intDataX, intDataY)
End If
Next X
'Creates Fields for first half of Questions
For X = 1 To (Int(rcnt / 2))
' Set positioning values for new controls.
intLabelX = 50
intLabelY = 100 * (4 * X) - 90
Set ctlLabel = CreateControl(frmNewForm.Name, acLabel, , "", "",
intLabelX, intLabelY, intLabelW, intLabelH)
Next X
'Creates Fields for second half of Questions
For X = (Int(rcnt / 2) + 1) To rcnt
' Set positioning values for new controls.
intLabelX = 5500
intLabelY = 100 * (4 * (X - (Int(rcnt / 2)))) - 90
Set ctlLabel = CreateControl(frmNewForm.Name, acLabel, , "", "",
intLabelX, intLabelY, intLabelW, intLabelH)
Next X

strFormName = frmNewForm.Name

'Name Answer Controls
X = 1
For Each Ctrldc In frmNewForm.Controls
If Ctrldc.ControlType = acTextBox Or Ctrldc.ControlType = acComboBox
Then
Ctrldc.Name = ("A" & X)

Ctrldc.Properties("AfterUpdate") = "[Event Procedure]"
Ctrldc.Properties("BeforeUpdate") = "[Event Procedure]"
Set DCmdl = frmNewForm.Module
strWaltSEreference = "dim blnReturnValue as Boolean" & vbCrLf &
"blnReturnValue = ClassSystemEdits.SystemEdits" _
& vbCrLf & "If blnReturnValue = False then" & vbCrLf &
"docmd.cancelevent" & vbCrLf & "End If"

lngReturn = frmNewForm.Module.CreateEventProc("BeforeUpdate",
Ctrldc.Name)
frmNewForm.Module.InsertLines lngReturn + 1, vbTab &
strWaltSEreference

'GoToNextControl
Select Case Combo82.value

Case "Mag2K3", "Samp2K", "Mag2K1", "DE03", "DTC1206",
"HR03", "HR02", "PPAR3_TMSV", "PRE03", "REB04", "DB_SVY_06", "EXIT_LETTER",
"REB06", _
"W1_Mail", "W2_Mail", "W3_Mail", "FINE_PRINT", "PBRC04",
"2.50_SURV", "Samp02", "MAG2K5", "MORE", "MORE_USER", "TAZ_BRC", _
"CVT_WAVE3", "JUN05", "CVT_DWF2005", "CVT_DWF2006",
"HNV_SURV_SUMFALL05", "HNV_ENR_SUMFALL2005", "ORNC_BRC_05", "ORNC_DE_BRC",
"ABAT_05", "ORNC_DE_BRDOPTIN_BRC", _
"C_06", "BC_06", "C_HAQ", "WELCOME"
strDCAutoAns = "Private Sub A" & X & "_AfterUpdate()" _
& vbCrLf & "Call ClassDataEntryLogic.a" & X & "logic" &
vbCrLf & "End Sub" & vbCrLf & _
"Private Sub A" & X & "_Change()" & vbCrLf & "Call
ClassDataEntryLogic.GoToNextControl" & vbCrLf & _
"End Sub"

Case Else
strDCAutoAns = "Private Sub A" & X & "_AfterUpdate()" _
& vbCrLf & "Call ClassDataEntryLogic.a" & X & "logic" &
vbCrLf & "End Sub"

End Select
With DCmdl
.InsertText strDCAutoAns
End With
X = X + 1
End If
Next Ctrldc
'Names Question Controls
X = 1
For Each Ctrldc In frmNewForm.Controls
If Ctrldc.ControlType = acLabel Then
Ctrldc.Name = ("Q" & X)

X = X + 1
End If
Next Ctrldc
'Loads Values for answers
rs.MoveFirst
'Setup Column Widths
colwid = "0 In;1 In"
'The control tags are set to equal the question ID field
For Each Ctrldc In frmNewForm.Controls
If Ctrldc.ControlType = acTextBox Then
With Ctrldc
.BackColor = 8454143
.Tag = rs.Fields("quest_id")
End With
rs.MoveNext
'AnswerLookup is a function that creates the following SQL statement -
'= "select answer_data, answer_translated from question_valid_answers "
& _
'"where quest_id = " & qid
ElseIf Ctrldc.ControlType = acComboBox Then
With Ctrldc
.BackColor = 8454143
.ColumnCount = 2
.ColumnHeads = False
.BoundColumn = 1
.ColumnWidths = colwid
.LimitToList = True
.RowSource = AnswerLookup(rs.Fields("quest_id"))
.Tag = rs.Fields("quest_id")
End With
rs.MoveNext
End If
Next Ctrldc
'Loads Formats for All Answers
rs.MoveFirst
For Each Ctrldc In frmNewForm.Controls
If Ctrldc.ControlType = acTextBox Then
'setup search string
strSrchCrit = "[QUEST_ID] = " & Ctrldc.Tag
'begin searching
rs.FindFirst strSrchCrit
'Check if found
If rs.NoMatch Then
MsgBox "Matching Question Not Found"
Else
strFormat = rs!Format

Select Case strFormat
Case "D"
With Ctrldc
.InputMask = "99/99/9999;;_"
.DefaultValue = "12319999"
End With

Case "P"
With Ctrldc
.InputMask = "!\(999)\ 000\-0000;;_"
.DefaultValue = "9999999999"
End With

Case "M"
With Ctrldc
.Format = "Fixed"
.DecimalPlaces = "2"
.DefaultValue = "0.00"
End With

Case "R"
With Ctrldc
.Format = "Fixed"
.DecimalPlaces = "0"
.DefaultValue = "0"
End With

Case "N"
'Do Nothing

'Rest of the validation is placed in the Class System
Edits code
Case "A" 'will allow answers "1" or "0"
With Ctrldc
.ControlTipText = "A"
.AutoTab = True
.InputMask = "0;;"
End With

Case "B" 'will allow answers "1" or "0"
With Ctrldc
.ControlTipText = "B"
.AutoTab = True
.InputMask = "0;;"
End With

Case "C" 'age
With Ctrldc
.ControlTipText = "C"
.AutoTab = True
.InputMask = "00;;"
End With
Case Else
MsgBox "Unknown Case"

End Select
End If
End If
Next Ctrldc

' Load Values for Questions
' Added DoCmd.Maximize to correct minimizing problem with form
rs.MoveFirst
For Each Ctrldc In frmNewForm.Controls
If Ctrldc.ControlType = acLabel Then
With Ctrldc
.Caption = rs.Fields("quest_text")
.TextAlign = 3
End With
rs.MoveNext
End If
Next Ctrldc
frmNewForm.NavigationButtons = False
DoCmd.Close acForm, frmNewForm.Name, acSaveYes
DoCmd.Maximize
DoCmd.SetWarnings False
DoCmd.Rename "New_Form", acForm, strFormName
DoCmd.SetWarnings True
Me.New_Form.SourceObject = "New_Form"
p_source_code.value = ""
lblItemCode.Caption = ""
p_white_mail.value = ""
p_source_code.Requery ' attempt to clean up source code list
Call cmdClear_Click2
'Added to fix jump to new form
DATE_RECEIVED.SetFocus
Application.VBE.MainWindow.Visible = False
Exit Sub
errhand:
MsgBox (Err.Description)
End Sub

 

[Dirk Goldgar]

In

When you select a item from a combo Box on the main form, VBA then
goes out to several tables and creates a brand new subform based on
the selection. So to answer you question it creates a new subform
control at runtime.

It was done this way so a new form would not have to be created when
new surveys were added. You just add the questions to one table, add
the possible answers to another table, and the question set
identifier to a third table, then add the question set defaults to
the code. The combo box on the main form lists the question set
identifer and when you select one, the code creates the subform from
the other tables.

Hope that answers your question, do you think you can help me?

I suspect that your delay problem has to do with the fact that you are
creating code for this new form on the fly. I'm only theorizing, but I
figure that puts the database's VB project into an uncompiled state.
Then the first time you do anything that needs to execute VBA code, or
at least any code behind that form, the entire VB project has to be
compiled.

The difference between the behavior under Access 2007 and Access 97
would probably be accounted for by the change in the structure of the VB
project between Access 97 and Access 2000. In Access 97, each module is
a separate compilation unit. With Access 2000 (and all later versions)
the whole VB project is one monolithic unit, so you can't compile just
one module. In Access 97, doing what you're doing, only the new form's
module would need to be compiled; now, in Access 2007, all modules have
to be recompiled.

If I were designing this, I don't think I'd create new forms and new
modules at run time. Of course, I don't know the specific requirements
you have to fulfill. You may want to look at Duane Hookom's "At Your
Survey" database for an alternative approach:

http://www.rogersaccesslibrary.com/Otherdownload.asp?SampleName='At Your Survey 2000'

Without changing your overall design approach, the best attack I can
think of is to not create a module for the dynamically created form.
Instead, design the event-handling procedures as public functions in a
standard module, generalizing their code so that they act on
Screen.ActiveControl and (maybe) Screen.ActiveForm instead of on a
specific named control; or else they could be called with references to
the control and form to be processed. Then set the event *properties*
of the form and controls to invoke the desired functions as function
expressions; e.g.,

BeforeUpdate: =GeneralBeforeUpdateProc()

One unrelated thing I can think of that *may* also be playing a part in
your delay is Name AutoCorrect. If you haven't turned that off, I'd
recommend doing so.

 

[Robert A.]

Dirk Thanks for the info, it is very insightful, but I am going to need to
throw another wrench in the gears. I need to explain I am not the person who
origially wrote the code, and I am coming into his a little green so bare
with me. I tried running the database on another near identical computer and
it runs fine. I tried a third and I get the same problem. As it stands I have
tried it on 5 computers and of those, 1 runs it fine no delays to speak of.

I believe you are right about the code not being in a compiled state at run
time, which may cause the problem, But then why whould one machine not be
seeing the delay in the DB. Can you think of any reason that a DB would see
problem from one machine to the next?

 

[Dirk Goldgar]

In

Dirk Thanks for the info, it is very insightful, but I am going to
need to throw another wrench in the gears. I need to explain I am not
the person who origially wrote the code, and I am coming into his a
little green so bare with me. I tried running the database on another
near identical computer and it runs fine. I tried a third and I get
the same problem. As it stands I have tried it on 5 computers and of
those, 1 runs it fine no delays to speak of.

I believe you are right about the code not being in a compiled state
at run time, which may cause the problem, But then why whould one
machine not be seeing the delay in the DB. Can you think of any
reason that a DB would see problem from one machine to the next?

Hmm. If those computers are all running the same version of Access, or
even if they are all running some version from Access 2000 to 2007, and
they all have about the same processing power (so it's not that the one
computer is extraordinarily fast), then I can only think of a couple of
factors that might be varying from computer to computer:

1. Name AutoCorrect. I mentioned this at the end of my last message:

Did you check that out? I'm not sure if this is a setting that travels
with the .mdb file, or if it's an application-wide setting. If the
latter, it could be different on different computers.

2. User-authorization for exclusive database access.

This is really reaching, but in order to make a run-time design change
in your database, the user's file access has to be promoted from its
original shared access (assuming you've got the default options set) to
exclusive access. It could be that there's something about the
resolution of the necessary permissions that is just taking a lot longer
on most computers, but not on that one. Maybe that computer has its
default open mode set to exclusive access, or something.

 

[Robert A.]

Dirk,
First I just want to thank you so much for helping me out, It's much
appreciated. Next time your in Chicago I'll take you out for a steak or
something.

Ok, on to the good stuff,

As far as Name autocorrect, in 2007 I can only assume that it is the
autocorrect options. There is no autocorrect option for Name. On one machine
that is showing the delay problem i turned all of the autocorrect options to
off, but I still see the delay. So I am not quite sure if i'm missing
something or I am not in the right place to get to these settings. Maybe you
could point me in the right direction.

On your permissions suggestion it got me thinking. Since the DB's are stored
on the local machine ( the DB is copied to local when there are any changes
made in the database stored on our server) I tried to connect two machines to
the DB on the network. I got a very interesting result. I got an error I have
not seen since Access 2000 " The database has been placed in a state by user
'Admin' on machine 'xxxxxxxxx' that prevents it from being opened or locked "
If memory serves me correct, this was an error in AC2000 that was fixed with
a service pack. The DB is shared and set that way, unless again, I am missing
something. You got any ideas on this one.

 

[Dirk Goldgar]

In

Dirk,
First I just want to thank you so much for helping me out, It's much
appreciated. Next time your in Chicago I'll take you out for a steak
or something.

Ok, on to the good stuff,

As far as Name autocorrect, in 2007 I can only assume that it is the
autocorrect options. There is no autocorrect option for Name.

No, that's not the same. I don't have A2007 installed, so I can't be
sure where this pesky setting is stored. In Access 2000-2003, you get
to it from the Tools -> Options... dialog, on the General tab of the
dialog. In Access 2007, I think you have to click the Microsoft Office
Button, and then choose Access Options.

On your permissions suggestion it got me thinking. Since the DB's are
stored on the local machine ( the DB is copied to local when there
are any changes made in the database stored on our server) I tried to
connect two machines to the DB on the network. I got a very
interesting result. I got an error I have not seen since Access 2000
" The database has been placed in a state by user 'Admin' on machine
'xxxxxxxxx' that prevents it from being opened or locked " If memory
serves me correct, this was an error in AC2000 that was fixed with a
service pack. The DB is shared and set that way, unless again, I am
missing something. You got any ideas on this one.

That is to be expected, given what you are doing. If one user makes a
design change to the database, that user's shared lock on the file is
promoted to exclusive access. At that point, the second user won't be
able to get in.