Word Add-In stops with hyperlink (Word 2013)

[davis1118]

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

[gmayor]

Because of the way Word is opened from a Hyperlink, the autoexec macro in the add-in doesn't run when you click the Hyperlink. A solution you could consider is to make the workbook with the links macro enabled and add a macro event to its ThisWorkbook module to ensure Word is started and the event in your add-in activated when the hyperlink is clicked . e.g. as follows

To prevent false triggering you could limit the Target.Range to the range that contains your hyperlinks.


Option Explicit

Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
Dim wdApp As Object
Dim wdDoc As Object
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
wdApp.Visible = True
wdApp.Run "Register_Event_Handler"
End Sub


the Hyperlink should then load the document in the running Word application.

Your Word module code should be

Option Explicit
Public EventHandler As New clsEventHandler

Public Sub Register_Event_Handler()
Set EventHandler.App = Word.Application
End Sub

Public Sub AutoExec()
Register_Event_Handler
End Sub

and the macros in the ThisDocument module are superfluous

[davis1118]

Thank you very much Graham. So this works perfect with a normal hyperlink, but today I was asked to make the sheets look more "visually appealing". I started to create rounded rectangle shapes to put the hyperlink into to give the appearance of a button. For some reason, placing the hyperlink in a shape is not letting the add-in run again. Sometimes I feel like I can never win.

Also, the only reason I had the DocumentOpen() and DocumentNew() in ThisDocument was to test the event before I created the template. The AutoExec() doesn't seem to work until it is ran as an add-in.