I finally figured out how to get the code below to run as an add-in, but now I have ran into another issue. I have created an Excel hyperlink interface that links to all the documents that the Engineers use. The documents are both Word and Excel. When I hyperlink to the Word documents, the BeforeSave event that is the Add-in doesn't work. But when I open the Word document directly the Add-in works fine. If I hyperlink to the Word document FROM a Word document then the Add-in works. It only seems to stop working when opening from the Excel hyperlink. I even made sure to turn of the excel BeforeSave add-in and place a hyperlink in a workbook free of any macros, but the Word Add-in still didn't work.
I'm assuming that because it is opened from Excel that the event is not seeing Word being opened? But I'm not sure what I am missing.
Here is my code:
This Document:
Private Sub Document_New()
Register_Event_Handler
End Sub
Private Sub Document_Open()
Register_Event_Handler
End Sub
Module (mdlEventConnect):
Dim EventHandler As New clsEventHandler
Public Sub Register_Event_Handler()
Set EventHandler.App = Word.Application
End Sub
Public Sub AutoExec()
Set EventHandler.App = Word.Application
End Sub
Class Module (clsEventHandler):
Public WithEvents App As Word.Application
Private Sub App_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI Then
GoTo lbl_End
Else
Dim myForm As frmSaveMethod
Dim i As Long, bAdd As Boolean: bAdd = True
Dim sTab As String
Dim oSection As Section
Dim oHF As HeaderFooter
Dim myName As String
Dim ext As String
Dim myPath As String
Dim T As String
Dim fso As Object
myName = Left(ActiveDocument.Name, (InStrRev(ActiveDocument.Name, ".") - 1))
ext = Right(ActiveDocument.Name, Len(ActiveDocument.Name) - InStrRev(ActiveDocument.Name, "."))
myPath = ActiveDocument.Path & "\"
T = Format(Now, "DDMMMyy")
'On Error GoTo lbl_Error
'SAVE & UPDATE MESSAGE BOX
Set myForm = New frmSaveMethod
myForm.Show
Select Case myForm.Tag
Case 1
'FOOTER SECTION
With ActiveDocument.Sections.First.Footers(wdHeaderFooterPrimary).Range
For i = 1 To .Fields.Count
If .Fields(i).Type = wdFieldPage Then
bAdd = False: Exit For
End If
Next
sTab = vbTab & " "
If bAdd = True Then
.Fields.Add .Characters.Last, wdFieldEmpty, "FILENAME", False
.InsertAfter "_"
.Fields.Add .Characters.Last, wdFieldEmpty, "DATE \@ ""DDMMMyy""", False
.InsertAfter sTab
.Fields.Add .Characters.Last, wdFieldEmpty, "PAGE", False
.InsertAfter " of "
.Fields.Add .Characters.Last, wdFieldEmpty, "NUMPAGES", False
End If
End With
For Each oSection In ActiveDocument.Sections
For Each oHF In oSection.Footers
oHF.Range.Font.Size = 8
Next
Next
'-SAVE & BACKUP SECTION-
If ActiveDocument.Path = "" Then GoTo lbl_Exit
'SAVE AS PDF
ActiveDocument.ExportAsFixedFormat _
OutputFileName:=myPath & myName & ".pdf", _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True
'SAVE IN ARCHIVE FOLDER
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(ActiveDocument.Path & "\Archive") Then
fso.CreateFolder (ActiveDocument.Path & "\Archive")
End If
fso.CopyFile ActiveDocument.FullName, ActiveDocument.Path & "\Archive\" & myName & "_" & T & "." & ext
ActiveDocument.Save
Case 2
'MORMAL SAVE - NO MACRO
ActiveDocument.Save
Case 3
'CANCEL BUTTON
Cancel = True
End Select
Unload myForm
Set myForm = Nothing
lbl_Exit:
Set fso = Nothing
End If
lbl_End:
Exit Sub
lbl_Error:
MsgBox "The following error occurred: " & Err.Description
Unload myForm
Set myForm = Nothing
End Sub
Thanks again for the help. - David