Code does not always stop on DoCmd.OpenForm

[April15Hater]

Hi guys-

Maybe it's just an Access 07 fluke, but I have the following code:

DoCmd.OpenForm "frmTrackingData", acNormal, , , , acDialog, intProductionID

and sometiems it'll stop the code on form open, but intermittently once in a while, the code keeps running. Any ideas where to start looking to fix this one?

Thanks,

Joe

 

[rainman89]

no but cant you put exit sub after the docmd.openform just to make sure it doesnt keep going?

 

[April15Hater]

No, because I have code after it that needs to run. If I put Exit Sub, the subsequent code will not run.

 

[rainman89]

No, because I have code after it that needs to run. If I put Exit Sub, the subsequent code will not run.

Guess i misunderstood then

This might not make sense either, but why not put the other code before the openform code then?

 

[pbaldy]

Ray, that's a standard technique to open a form for user input, then continue. In other words, the code after that line depends on something from the form that was opened.

Joe, I've never seen that fail. You're saying that the form is still open and visible, but the code kept running?

 

[rainman89]

Yeah I figured as much, but he wasn't clear about it so i was just fishing for details on it.

 

[Banana]

I apologize for being Captain Oblivious, but are you (April15Hater) absolutely sure you have the 'acDialog' option in the line where code didn't stop after opening the form?

It could be that you have two different procedure, one opening in dialog, and another not?

 

[April15Hater]

Hi Paul,
That's exactly what's happening. Bizzare, i know... The reason I know is that it is giving me the msgbox from the conditional 7 lines down while the new form opens, and that message isn't found anywhere else in the project and nothing else calls this function. Furthermore, I set the conditions so that the msgbox i mentioned earlier would trigger after form close, and it still didn't.

Hi Ray,
I appreciate your help. The subsequent code depends on things that are input into the form that is being opened. Here's all of my code:

Function ProductionInputSave()
Dim intProductionID As Integer
Dim rsProductionExist As ADODB.Recordset
Dim rsProduction As ADODB.Recordset
'''''''''''''Dummy Proof
If txtHouseCountDetail.Enabled = True And txtHouseCountDetail = "" Then msgFunctionCount = MsgBox("You did not have any units for the House Count function."): GoTo ErrorEnd
If txtMDUCountDetail.Enabled = True And txtMDUCountDetail = "" Then msgFunctionCount = MsgBox("You did not have any units for the MDU Count function."): GoTo ErrorEnd
If txtCommercialCountDetail.Enabled = True And txtCommercialCountDetail = "" Then msgFunctionCount = MsgBox("You did not have any units for the Commercial Count function."): GoTo ErrorEnd
IntX = 1
For IntX = IntX To 13
    If Me.Controls(("cboFunctionType") + Format$(IntX)) <> "" And Me.Controls(("txtFunctionDetail") + Format$(IntX)) = "" Then msgFunctionCount = MsgBox("You did not have any units for the  " & cboFunctionType1.Column(2) & " function."): GoTo ErrorEnd
Next IntX
If cboFunctionSel = "" Then MsgBox "Please select a function.": GoTo DupeEnd
''''''''''''''
Set rsProductionExist = New ADODB.Recordset
Set rsProduction = New ADODB.Recordset
'Resetting variables
If txtAerial = "" Then Call ResetTextBox(txtAerial)
If txtUnderground = "" Then Call ResetTextBox(txtUnderground)
If txtUnits = "" Then Call ResetTextBox(txtUnit)
If IsNull(chkSetup) = True Or chkSetup = False Then
    With Me.chkSetup
        .Enabled = True
        .Value = 0
        .Enabled = False
    End With
End If
'Add Line of Production
intProductionID = NewProductionLine()
DoCmd.OpenForm "frmTrackingData", acNormal, , , , acDialog, intProductionID
With rsProductionExist
    .ActiveConnection = CurrentProject.Connection
    .Source = "SELECT ProductionID FROM tblProductionTracking WHERE ProductionID = " & intProductionID
    .CursorType = adOpenDynamic
    .LockType = adLockOptimistic
    .Open
    If .EOF = True Then msgTracking = MsgBox("You did not save a Function Track for this map. Are you sure you want to continue?", vbYesNo)
    If .EOF = True And msgTracking = vbYes Then GoTo DeleteProductionLineItem
    If msgTracking = vbNo Then GoTo ErrorEnd
    .Update
    .Close
End With
If FunctionTrackExists(Forms("frmProductionInput").Controls("cboFunctionSel"), ERRORTRACKING) = True Then
DeleteProductionLineItem:
    With rsProduction
        .ActiveConnection = CurrentProject.Connection
        .Source = "SELECT * FROM tblProductionInput WHERE ProductionID = " & intProductionID
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        .Open
        .Delete
        .Update
        .Close
    End With
    GoTo ErrorEnd
End If
'Add detail lines of production to tblProductionInputDetail
Call NewProductionLineDetail(intProductionID, "Aerial", Nz(txtAerial.Value, 0))
Call NewProductionLineDetail(intProductionID, "Underground", Nz(txtUnderground.Value, 0))
Call NewProductionLineDetail(intProductionID, "Unit", Nz(txtUnit.Value, 0))
If chkSetup = False Or chkSetup = 0 Then Call NewProductionLineDetail(intProductionID, "Setup", 1)
Call AddSubfunctionData(intProductionID)
'Tidy up Form
With Me
    .chkSetup = False
    .txtAerial = Null
    .txtUnderground = Null
    .txtUnit = Null
    .txtComments = Null
    .txtDate.SetFocus
    .fmeStatus = 1
    .txtHouseCountDetail = Null
    .txtMDUCountDetail = Null
    .txtCommercialCountDetail = Null
    For IntX = 1 To 13
        .Controls("txtFunctionDetail" + Format$(IntX)) = Null
        .Controls("cboFunctionType" + Format$(IntX)) = Null
    Next IntX
    .ProductionList.Requery
End With
DupeEnd:
ErrorEnd:
    txtAerial.Enabled = True
    txtUnderground.Enabled = True
    txtUnit.Enabled = True
    chkSetup.Enabled = True
    If FunctionTypeSearch(cboFunctionSel, "Aerial") = False Then txtAerial.Enabled = False
    If FunctionTypeSearch(cboFunctionSel, "Underground") = False Then txtUnderground.Enabled = False
    If FunctionTypeSearch(cboFunctionSel, "Unit") = False Then txtUnit.Enabled = False
    If FunctionTypeSearch(cboFunctionSel, "Setup") = False Then chkSetup.Enabled = False
End Function

 

[April15Hater]

Banana,
Positive. What's weird is it is intermittent, so I know it is in there, and it should be stopping it.

 

[pbaldy]

I note that you are passing something in OpenArgs; is there code in the form being opened to handle it, and could it be doing something weird based on what value is passed?

 

[April15Hater]

hmmm, it might be, the line before it assigns intProductionID it's value with the New PRoduction Line Function, but that one is fairly straightforward:

Function NewProductionLine()
Dim rsProduction As ADODB.Recordset
'''''''''''''''''''''''''''''''''''''''''''
'FUNCTION PURPOSE
'This function is used to add a new record to tblProductionInput from frmProductionInput
'CALLABLE BY
'
'FUNCTION DEPENDENCY OBJECTS
'None
'''''''''''''''''''''''''''''''''''''''''''
Set rsProduction = New ADODB.Recordset
With rsProduction
    .ActiveConnection = CurrentProject.Connection
    .Source = "SELECT * FROM tblProductionInput"
    .CursorType = adOpenDynamic
    .LockType = adLockOptimistic
    .Open
    .AddNew
    ![ContractorID] = txtContractorID
    ![Status] = fmeStatus
    ![CompleteDate] = txtDate
    ![Comments] = txtComments
    ![FunctionID] = cboFunctionSel
    ![Description] = txtDescription
    NewProductionLine = !ProductionID
    .Update
    .Close
End With
End Function

 

[pbaldy]

I was wondering if there was code in frmTrackingData to do something with the OpenArgs that got passed to it. I'm totally shooting from the hip here though. Didn't know if code there might close or hide that form, which would cause the code in the calling form to continue.

 

[April15Hater]

Oh, I get ya. I can't see anything that would cause that. Here's the code for frmTrackingData just for the heck of it:

Option Compare Database

Private Sub cboTrackableSel_AfterUpdate()
Dim rsInputMask As ADODB.Recordset
If IsNull(cboTrackableSel) Then Exit Sub
Set rsInputMask = New ADODB.Recordset

With rsInputMask
    .ActiveConnection = CurrentProject.Connection
    .Source = "SELECT FunctionTrackingID, InputMask FROM tblFunctionTracking WHERE FunctionTrackingID = " & cboTrackableSel
    .CursorType = adOpenDynamic
    .LockType = adLockOptimistic
    .Open
    Me.txtTracking.InputMask = Nz(!InputMask, "")
End With
With Me.lstTracking
    .RowSource = "SELECT tblProductionTracking.ProductionTrackingID, tblProductionTracking.ProductionID, " _
        & "tblProductionTracking.FunctionTrackingID, tblProductionTracking.TrackingNumber " _
        & "FROM tblProductionTracking " _
        & "WHERE (((tblProductionTracking.[FunctionTrackingID])=[Forms]![frmTrackingData]![cboTrackableSel])) AND " _
        & "ProductionID = " & Me.OpenArgs & ";"
End With
Me.lstTracking.Requery
End Sub

Private Sub cmdAddTracking_Click()

Dim rsTrackingData As ADODB.Recordset
Dim rsFunctionTrack As ADODB.Recordset
Dim rsTrackableFunction As ADODB.Recordset
If cboTrackableSel = "" Or IsNull(cboTrackableSel) Then MsgBox "Please enter a Trackable Item.", vbCritical: Exit Sub
Set rsTrackingData = New ADODB.Recordset
Set rsFunctionTrack = New ADODB.Recordset
Set rsTrackableFunction = New ADODB.Recordset
If Forms("frmProductionInput").Controls("fmeStatus") <> 2 And _
    FunctionTrackExists(Forms("frmProductionInput").Controls("cboFunctionSel"), txtTracking) = True And _
    cboTrackableSel.Column(3) <> "" Then
    MsgBox "Tracking number " & txtTracking & " already exists for this function.  Please contact a manager if you think this is an error.", vbCritical
    ERRORTRACKING = Me.txtTracking.Value
    Me.lstTracking.Requery
    Exit Sub
End If
With rsTrackableFunction
    .ActiveConnection = CurrentProject.Connection
    .Source = "SELECT * FROM tblFunctionTracking WHERE FunctionTrackingID = " & cboTrackableSel
    .CursorType = adOpenDynamic
    .LockType = adLockOptimistic
    .Open
    With rsFunctionTrack
        .ActiveConnection = CurrentProject.Connection
        .Source = "SELECT ProductionID, FunctionTrackingID " _
                & "FROM tblProductionTracking " _
                & "WHERE ProductionID = " & Me.OpenArgs & " AND FunctionTrackingID = " & cboTrackableSel
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        .Open
        If .EOF = False And IsNull(rsTrackableFunction!Hierarchy) = False Then
            MsgBox "You can only assign one Function Track Item per Production Item.", vbCritical
        Else
            With rsTrackingData
                .ActiveConnection = CurrentProject.Connection
                .Source = "tblProductionTracking"
                .CursorType = adOpenDynamic
                .LockType = adLockOptimistic
                .Open
                .AddNew
                !ProductionID = Me.OpenArgs
                !FunctionTrackingID = cboTrackableSel
                !TrackingNumber = txtTracking
                .Update
                .Close
                Me.txtTracking.Value = ""
                Me.lstTracking.Requery
            End With
        End If
        .Close
        Me.lstTracking.Requery
    End With
    .Close
    Me.lstTracking.Requery
End With

DupeEnd:
ERRORTRACKING = 0
With Me.cboTrackableSel
    .Requery
    .SetFocus
End With
Me.lstTracking.Requery
End Sub

Private Sub cmdClose_Click()
DoCmd.Close acForm, "frmTrackingData"
End Sub

Private Sub Form_Load()
Dim rsFunctionTrackFind As ADODB.Recordset
Set rsFunctionTrackFind = New ADODB.Recordset
With rsFunctionTrackFind
    .ActiveConnection = CurrentProject.Connection
    .Source = "SELECT tblFunctionTracking.FunctionTrackingID, tblFunctionTracking.FunctionID, IsNull([Hierarchy])=False AS showme " _
            & "FROM tblFunctionTracking " _
            & "WHERE (((tblFunctionTracking.FunctionID)= " & Forms("frmProductionInput").Controls("cboFunctionSel") & ") AND " _
            & "((IsNull([Hierarchy])=False)=-1));"
    .CursorType = adOpenForwardOnly
    .LockType = adLockReadOnly
    .Open
    Me.cboTrackableSel = rsFunctionTrackFind!FunctionTrackingID
    .Close
End With
Me.lstTracking.Requery
End Sub

 

[gemma-the-husky]

could it be that if the form is already open in non-dialog mode, (eg hidden, or obscured)it ignores this open dialog command and carries on running?

 

[April15Hater]

Would i be able to tell if it is open without the obvious looking for the window? Or perhaps a different approach would be how can i find out if the one that is open is nondialog?

 

[rainman89]

Would i be able to tell if it is open without the obvious looking for the window? Or perhaps a different approach would be how can i find out if the one that is open is nondialog?

this will help see if a form is open
http://www.mvps.org/access/forms/frm0002.htm

 

[April15Hater]

cool, thanks, Now I gotta wait until it does it again!

 

[gemma-the-husky]

heres a function to determine whether a form is open

if isopen("formname") then


Private Function IsOpen(strForm As String)
IsOpen = (SysCmd(acSysCmdGetObjectState, acForm, strForm) > 0)
End Function

 

[wiklendt]

Hey guys,

i'm having the same issue except the code runs through the acDialog every time. here's the code i'm using, it's pretty basic:

    'open the targets form so changes can be made
    DoCmd.OpenForm "frmTargets_Display", acFormDS, , , , acDialog 'open as dialog, so the next code runs after changes
    
    'the following will delete all records in ttmpProfiles and recalculate them according to new target display settings
    DoCmd.OpenQuery "qdelProfiles", acNormal, acEdit
    DoCmd.OpenQuery "qappProfiles", acNormal, acEdit

    Me.sfrmCCC_TargetAbGroups.Requery

so what's happening is it's opening the form in dialog mode, but also then tries to run the action queries straight away. they work ok, but run at the wrong time (should run on dialog form close).

i don't want to put the code in the "on close" event of that form because the form will be used elsewhere for other things.

any ideas? at this stage i have no hidden forms.

ta.

 

[vbaInet]

How about using DoEvents?