Copy ThisDocument Module from Template to Document

[gmaxey]

At one point I had, and still do but can't find it, a procedure that copies the ThisDocument module code from a template to the ThisDocument module of new documents created from the template. This way documents could be sent to other users without access to the template and the ContentControl Exit and Entry events will still work.

Working with the VBE is certainly not my strong point so having try to recreate that code is much dreaded.

Does anyone have a procedure to do that available and would share? Thanks.

[gmaxey]

I still can't find the code I used before, but I've managed to cobble together something that is working for the present:


Sub AutoNew()
Dim doc As Word.Document
Dim sCode As String
Set doc = ActiveDocument
sCode = ReadModule
With doc.VBProject.VBComponents("ThisDocument").CodeModule
.DeleteLines 1, .CountOfLines
.AddFromString sCode
End With
lbl_Exit:
Exit Sub
End Sub
Function ReadModule() As String
Dim VBProj As Object 'VBIDE.VBProject
Dim VBComp As Object 'VBIDE.VBComponent
Dim oTemplate As Document
Set oTemplate = ThisDocument
Set VBProj = oTemplate.VBProject
Set VBComp = VBProj.VBComponents("ThisDocument")
On Error Resume Next
ReadModule = VBComp.CodeModule.Lines(1, VBComp.CodeModule.CountOfLines)
lbl_Exit:
Set oTemplate = Nothing
Set VBProj = Nothing
Set VBComp = Nothing
Exit Function
End Function


If anyone has a better method I would appreciate your suggestions. Thanks

[gmayor]

Greg, I think you may be referring to the procedure we discussed in private correspondence last year. The code I suggested is below. Frankly it doesn't do anything that yours doesn't. Don't forget to save the document with the added code as macro enabled.


Option Explicit
Sub AutoNew()
Dim oDoc As Document
Set oDoc = ActiveDocument
UpdateVBACode oDoc, "ThisDocument"
lbl_Exit:
Set oDoc = Nothing
Exit Sub
End Sub

Function UpdateVBACode(oDoc As Document, strModule As String) As Boolean
Dim oSource As Document
Dim strLines As String
Dim i As Long, j As Long
Set oSource = ThisDocument
i = oDoc.VBProject.VBComponents(strModule).CodeModule.CountOfLines
oDoc.VBProject.VBComponents(strModule).CodeModule.DeleteLines 1, i
With oSource.VBProject.VBComponents(strModule).CodeModule
strLines = .Lines(1, .CountOfLines)
oDoc.VBProject.VBComponents(strModule).CodeModule.AddFromString strLines
End With
lbl_Exit:
Set oSource = Nothing
Exit Function
End Function

[gmaxey]

Graham,

That looks to be it if not very close. You obviously have a better reference management system than I do or raw memory one ;-)

Do you recall what project it is related to? I spent an hour last night trying to remember what I was working on the last time I needed this process.

Thanks.

[gmayor]

My memory is even worse than yours and my management system simply relied on Outlook search, which produced the code but little else. :rotlaugh: