Writing code into an Event Procedure via VBA - Access

Question

I have an Access form used for data entry of written application forms. It has a lot of fields (in fact the max 255 approx.). I need to put some simple code into the AfterUpdate event on all 255 controls.

Doing that manually seems a bit dumb so I made a procedure to loop through all the relevant controls to create an Event Procedure on AfterUpdate. Now I need to put one simple line of code into each of those Event Procedures.

Does anyone know how I do that programmatically?

I can't seem to find the answer anywhere.

Thanks for any tips anyone can throw me on this.

 

Answer 1

Chip Pearson has a webpage for excel, but I think it will also work with Access

 

http://www.cpearson.com/Excel/VBE.aspx

 

What may be easier is to write a macro that outputs to a text file the 256 functions, then copy the text file back into your VBA module.  I've done this before many times.

Answer 2

You may be able to use something a bit easier to manage.

 

Private Sub Form_Open(ByRef intCancel As Integer)
    ' Set the After Update Handler for all Controls
    ' with 'IncludeInHandler' in their Tag Property.
    
    Dim Ctl As Access.Control
    
    For Each Ctl In Me
        If Ctl.Tag = "IncludeInHandler" Then
            Ctl.AfterUpdate = "=AfterUpdateHandler([" & Ctl.Name & "])"
        End If
    Next Ctl

End Sub


Private Function AfterUpdateHandler(ByRef Ctl As Access.Control)
    ' Common After Update Handler for all Controls
    ' with 'IncludeInHandler' in their Tag Property.

    With Ctl
        MsgBox .Name
        MsgBox Nz(.Value, "")
        ' Etcetera
    End With

End Function

 

 

Regards,

Chris.

Answer 3

Joel

Thanks for that.

I can see how that could work and it could turn out to be quite straightforwards.

I was stuck on finding some way to reference the procedures via an object model but maybe that's not the most useful way to think of it.

I'll try it and see what happens.

Thanks again,

Ed

Answer 4

Chris

Thanks for this too.

If I can set the tag property as I loop through my controls, maybe I could just directly set the Afterupdate property to =AfterUpdateHandler([" & Ctl.Name & "])? I guess there's some reason to go via the tag first but I can't see it yet.

Anyway thanks for another practical take on this.

Time to go and try it all and see what works.

Thanks again

Regards

Ed

 

Answer 5

If the Controls were named Control_1, Control_2…Control_255 then there would be no reason to use the Tag Property. (Index the Control name with the number.)

 

If the Controls are not named sequentially then you can select them all in design view and enter IncludeInHandler in their Tag property.

 

Regards,

Chris.

 

Answer 6

Chris

That makes sense. I've got some ways to tackle this now which is great.

However I've just noticed that some of these controls already have some afterupdate() code in them which I need to preserve so now I need to add my new line to what's already there rather than overwrite it.

If you happen to have that figured too then please let me know how you'd do it!

Meanwhile I'll try and figure something out.

Regards

Ed

Answer 7

Well, without knowing what ‘other’ code is already there it is impossible to say.

 

Can you post the ‘other’ code that is already there?

 

Regards,

Chris.

Answer 8

Another way to write this sort of thing, provided there is no other code behind the Form, is to also remove its Class Module. (Set HasModule to No in design view.)

 

Then set the Form OnOpen Property:-

=SetEventHandlers([Form])

 

 

And in a Standard Module:-

Public Function SetEventHandlers(ByRef Frm As Access.Form)
    ' Set the After Update Handler for all Controls
    ' with 'IncludeInHandler' in their Tag Property.
    
    Dim Ctl As Access.Control
    
    For Each Ctl In Frm
        If Ctl.Tag = "IncludeInHandler" Then
            Ctl.AfterUpdate = "=AfterUpdateHandler([" & Ctl.Name & "])"
        End If
    Next Ctl

End Function


Public Function AfterUpdateHandler(ByRef Ctl As Access.Control)
    ' Common After Update Handler for all Controls
    ' with 'IncludeInHandler' in their Tag Property.

    With Ctl
        MsgBox .Name
        MsgBox Nz(.Value, "")
        ' Etcetera
    End With

End Function

 No code behind the Form...

 

Regards,

Chris.

Answer 9

Interesting.

But time for bed here in the UK. Not sure where you are but I need to take a break now.

Thanks for all your help.

Best regards

Ed

Answer 10

' I'm in Brisbane but, because I'm getting old, I might have a nap too. :-)
'
' If you get the impression I'm trying to avoid 255+ Event Handlers you are correct.
' Consider processing the exceptions rather than the rule...
'
' The Control Tag Property can now look like this (Pipe delimited):-
'
' No exception:
' IncludeInHandler|HandleException_0
'
' First exception:
' IncludeInHandler|HandleException_1
'
' Second exception:
' IncludeInHandler|HandleException_2
'
' Etcetera
'
' You should have less exceptions than the rule.
'
' Again with no Class Module behind the Form(s) if there is no other code behind the Form(s):-
'
Public Function SetEventHandlers(ByRef Frm As Access.Form)
    ' Set the After Update Handler for all Controls
    ' with 'IncludeInHandler' in their Tag Property.
    
    Dim Ctl As Access.Control
    
    For Each Ctl In Frm
        If InStr(Ctl.Tag, "IncludeInHandler") Then
            Ctl.AfterUpdate = "=AfterUpdateHandler([" & Ctl.Name & "])"
        End If
    Next Ctl

End Function


Public Function AfterUpdateHandler(ByRef Ctl As Access.Control)
    ' Common After Update Handler for all Controls
    ' with 'IncludeInHandler' in their Tag Property.

    If InStr(Ctl.Tag, "|") Then
        Application.Run Split(Ctl.Tag, "|")(1), Ctl
    Else
        MsgBox "Invalid Tag argument to Call."
    End If

End Function


Public Sub HandleException_0(ByRef Ctl As Access.Control)

    With Ctl
        MsgBox "Processing " & Split(.Tag, "|")(1) & " Handler for " & .Name & " on Form " & .Parent.Name
        MsgBox .Name
        MsgBox Nz(.Value, "")
        MsgBox .Parent.Name
        ' Etcetera
    End With

End Sub


Public Sub HandleException_1(ByRef Ctl As Access.Control)

    With Ctl
        MsgBox "Processing " & Split(.Tag, "|")(1) & " Handler for " & .Name & " on Form " & .Parent.Name
        ' Etcetera
    End With

End Sub


Public Sub HandleException_2(ByRef Ctl As Access.Control)

    With Ctl
        MsgBox "Processing " & Split(.Tag, "|")(1) & " Handler for " & .Name & " on Form " & .Parent.Name
        ' Etcetera
    End With

End Sub

' Regards,
' Chris. zzzzzzzzzzzzzzz

Answer 11

you can use the Form's Module and work with that

 

Dim frm as Form, mde as Module, ctl as Control
Set frm = Forms("MyForm")
Set mde = frm.Module

 

Then loop through all the controls and Identify the ones you want

 

For each ctl in frm.Controls

 

then use the the control's name to contruct the Event

 

strTarget = "Private Sub " & ctl.Name & "_AfterUpdate()"
strCode = "Whatever code you want to insert"
strEnd = "End Sub"

 

Now you can seach the mde to see if the code and target procedure exists and if it doesn't then insert it

 

        With mde
            ' note - the find method Uses ByRef to return the positions for start and end so we need to reset them to 1
            lngStartLine = 1: lngStartColumn = 1: lngEndLine = 1: lngEndColumn = 1
            If .Find(strCode, lngStartLine, lngStartColumn, lngEndLine, lngEndColumn) Then ' the code already exists
                GoTo Skip_Control
            End If
            
            If .Find(strTarget, lngStartLine, lngStartColumn, lngEndLine, lngEndColumn) Then ' see if there is an After Update Event
                .InsertLines lngEndLine + 1, strCode
            Else ' if not then insert it after the last procedure
                If .Find("End Sub", lngStartLine, lngStartColumn, lngEndLine, lngEndColumn) Then
                    .InsertLines lngEndLine + 1, ""
                    .InsertLines lngEndLine + 2, strTarget
                    .InsertLines lngEndLine + 3, strCode
                    .InsertLines lngEndLine + 4, strEnd
                Else ' or after the initial declarations
                    .InsertLines lngEndLine + 3, ""
                    .InsertLines lngEndLine + 4, strTarget
                    .InsertLines lngEndLine + 5, strCode
                    .InsertLines lngEndLine + 6, strEnd
                End If
            End If<br/><br/>That should get you started. <br/>

This code does assume that the code will be different for each control (I wrote it for a different application). so you may need to drop the first .Find(strCode ... and just look for the target.

 

---

Kent

Answer 12

Thanks to everyone for your suggestions.

It was all useful learning for me and the new procedure works and created the right module.I didn't need to avoid code behind the form so went the route of creating a module from VBA.

I found that using "Find" to search for procedure start lines returns line '0' if it doesn't find the procedure name it's looking for. That resulted in some new lines of code going in right at the top before "Option Compare database". I could have trapped for NoMatch I suppose but in the end I got it to right the whole thing from scratch. Also had some issues with valid control names not being valid procedure names and Access substituting underscores for invalid characters.

The thing that slowed down the debugging the most was that you cannot break the code once you have already inserted a line of code. That means you can't step through to where the problem is in the normal way.

I guess all examples can be useful to others so I'll copy the whole thing here,

Public Function AddCodeToControlEP()

'this adds code to the Event Procedures of various controls in a given form
'NB there is a method to search for the start line number of a procedure
'and then add lines after it
'However it turns out to be very prone to slips so writting the entire module from code
'seems much easier.............

On Error GoTo AddCodeToControlEP_Err
Dim ctrlname As String
Dim ctrlnameFull As String
Dim ctrltype As String

Set frm = Forms![F_RD_AppDetails]
Set mdl = frm.Module

        For Each control In frm.Controls
        ctrlname = control.Name
        
'skip the subforms
If ctrlname = "F_RD_Terminals" Or ctrlname = "F_RD_OtherServices" Then
Else
'skip the labels
If InStr(ctrlname, "label") = 0 Then
            'replace Paul's spaces with '_' to match what is needed for the EP name
            ctrlnameorig = ctrlname
            ctrlname = ReplaceChar(" ", "_", ctrlname)
            ctrlname = ReplaceChar("%", "_", ctrlname)
            ctrlname = ReplaceChar("-", "_", ctrlname)
            ctrlname = ReplaceChar("&", "_", ctrlname)
            ctrlname = ReplaceChar("/", "_", ctrlname)
            'Debug.Print ctrlname
    'add the new EPs
ctrltype = Right(ctrlname, 5)
    
Select Case ctrltype
    
    Case "Query"
        ' Add event procedure.
        lngReturn = mdl.CreateEventProc("AfterUpdate", ctrlname)
        NewCodeline = "Forms![F_RDcompleteApp]![F_RD_AppDetails].Form![" & ctrlnameorig & "].Tag = " & Chr$(34) & "Edited" & Chr$(34) & ""
        mdl.InsertLines lngReturn + 1, NewCodeline
        NewCodeline = "If Forms![F_RDcompleteApp]![F_RD_AppDetails].Form![" & ctrlnameorig & "] = " & Chr$(34) & raised & Chr$(34) & "Then "
        mdl.InsertLines lngReturn + 2, NewCodeline
        NewCodeline = "Forms![F_RDcompleteApp]![F_RD_AppDetails].Form![" & ctrlnameorig & "] = True"
        mdl.InsertLines lngReturn + 3, NewCodeline
        NewCodeline = "end if"
        mdl.InsertLines lngReturn + 4, NewCodeline
        NewCodeline = "AddRDNotes"
        mdl.InsertLines lngReturn + 5, NewCodeline
     
   
    Case "Notes"
        ' Add event procedure, AfterUpdate.
        lngReturn = mdl.CreateEventProc("AfterUpdate", ctrlname)
        NewCodeline = "Forms![F_RDcompleteApp]![F_RD_AppDetails].Form![" & ctrlnameorig & "].Tag = " & Chr$(34) & "Edited" & Chr$(34) & ""
        mdl.InsertLines lngReturn + 1, NewCodeline
        ' Add event procedure, OnClick.
        lngReturn = mdl.CreateEventProc("Click", ctrlname)
        NewCodeline = "AddRDNotes"
        mdl.InsertLines lngReturn + 1, NewCodeline
        
    Case Else
        ' Add event procedure.
        NewCodeline = "Forms![F_RDcompleteApp]![F_RD_AppDetails].Form![" & ctrlnameorig & "].Tag = " & Chr$(34) & "Edited" & Chr$(34) & ""
        lngReturn = mdl.CreateEventProc("AfterUpdate", ctrlname)
        mdl.InsertLines lngReturn + 1, NewCodeline
        
End Select
End If
End If
        Next control

Exit Function

AddCodeToControlEP_Err:
    MsgBox Err.Description & ctrlname
    Resume Next

End Function

Answer 13

re your commment - I found that using "Find" to search for procedure start lines returns line '0'

that's right. but remember 0 = False so

If .Find(strTarget, lngStartLine, lngStartColumn, lngEndLine, lngEndColumn) Then

if the same as

If .Find(strTarget, lngStartLine, lngStartColumn, lngEndLine, lngEndColumn)  <> 0 Then

Also you could use the property ctl.ControlType eg

Select Case ctl.ControlType

   case acTextBox, acListBox etc.

But I was rather fascinated with your line

lngReturn = mdl.CreateEventProc("Click", ctrlname)

I didn't know about that one.

 

---

Kent

Answer 14

Kent

Thanks for those useful points.

mdl.CreateEventProc was useful in as much as I found I was spending too much time de-bugging the cases where "Find" didn't give the desired result. Not that "Find" is intrinsically a problem, more that many control names in my modules had names that aren't valid as part of a procedure name and so I had to search for the 'translated' versions. At one point I just thought I'd try the other route of removing all the procedures and creating them from scratch using mdl.CreateEventProc. That way I at least now know exactly what is in the module.

Anyway, it was all new stuff to me and I'm very grateful to all who gave tips as I didn't find much on this topic on the web.

All the best

Ed

Answer 15

Hi Chris,

I really enjoyed your tip, but how can I use it with others events like double click?

Chalton.

Answer 16

Hi Chalton.

That is a very broad question so perhaps a new thread is required.

In the mean time a posting from a few years ago might explain it better.

http://www.access-programmers.co.uk/forums/showthread.php?t=166799

That thread is locked so if you have any questions please post them in this forum.
More specific information would be appreciated.

Regards,
Chris.

---

Brisbane Australia, GMT+10, Access 2003, Public at SkyDrive