How to programmatically add button event handler in word VBA document

Question

I have multiple buttons in my word document and I'd like to programmatically add event handlers to them.

After searching this site I managed to implement this code:

Sub AddEH()
    Set shp = GetObjectByName("reset_1")   
    Dim sCode As String
    sCode = "Private Sub " & "reset_1" & "_Click()" & vbCrLf & _
            "   MsgBox ""You Clicked the CommandButton""" & vbCrLf & _
            "End Sub"
    Me.VBProject.VBComponents("ThisDocument").CodeModule.AddFromString sCode
End Sub

GetObjectByName is my own function to get an object by name (if this can be simplified please suggest how)

Function GetObjectByName(ByVal name As String)
    For Each obj In Me.InlineShapes
        thisName = obj.OLEFormat.Object.name
        If thisName = name Then
            Set tb = obj.OLEFormat.Object 'must use in order to refer to an object
            Exit For
        End If
    Next obj
    Set GetObjectByName = tb
End Function

I "Call AddEH" at the end of "Document_Open()".

The new event handler is added and works as expected. The problem is that when the the user saved the doc and reopens it, the code tried to add the same event handler again and an error message appears.

How can I prevent this? I want to programmatically added ode to be entered only once.

Answer 1

I am not sure if your attempt to inject code into a document is the best attempt, but let's for the moment forget about that.

As far as I understand, you execute the routine that writes the code whenever the document is opened. As a consequence, that routine should check if the code is already present. You can access the code of a module using the lines-property of the CodeModule of a project. I created a simple function that searches for a string at the beginning of every line of code. The reason to look at the beginning is that the search needs to ensure that it doesn't find the code that creates the sub.

The code currently loops over all modules of a project of a document.

Function FindRoutine(doc As Document, searchString As String) As Boolean
    Dim VBProj As VBIDE.VBProject
    Dim VBComp As VBIDE.VBComponent

    Set VBProj = doc.VBProject
    If VBProj Is Nothing Then
        MsgBox "No code module found."
        Exit Function
    End If
    
    Set VBComp = VBProj.VBComponents("ThisDocument")
        
    For Each VBComp In VBProj.VBComponents
        Dim CodeMod As VBIDE.CodeModule
        Set CodeMod = VBComp.CodeModule
        
        Dim i As Long, line As String
        For i = 1 To CodeMod.CountOfLines
            line = Trim(CodeMod.Lines(i, 1))
            If Left(line, Len(searchString)) = searchString Then
                FindRoutine = True
                Exit Function
            End If
        Next
    Next
End Function

And your code that generates the routine could look like

Sub AddEH()
    Set shp = GetObjectByName("reset_1")
    Dim subDefinition As String
    subDefinition = "Private Sub " & "reset_1" & "_Click()"
    If Not (FindRoutine(ThisDocument, subDefinition)) Then

        Dim sCode As String
        sCode = subDefinition & vbCrLf & _
            "   MsgBox ""You Clicked the CommandButton""" & vbCrLf & _
            "End Sub"
        ThisWorkbook.VBProject.VBComponents("ThisDocument").CodeModule.AddFromString sCode
    End If
End Sub