How to ensure (using VBA) that all your Word add-ins are installed in the correct path
Article contributed by Dave Rado
Unfortunately, Word 2000 and 2002 use two Startup paths; the one that add-ins are supposed to be installed in, which is shown under Tools + Options + File Locations; and another one located in the program's installation folder. Even more unfortunately, many commercial add-ins install themselves in the wrong path – or even worse, in both paths, which can result in you or your users having duplicate menus and toolbars, and the unfortunate sensation of seeing double! This causes all sorts of unwanted headaches; for more details see What do Templates and Add-ins store?
To prevent this problem from arising, you could put the following macro into either Normal.dot (if it's for your own use only), or into an add-in that is installed in the correct Startup path; and you could call it from your AutoExec procedure.
Sub EnsureAddinsInCorrectPath()
Dim WrongStartupPath As
String, DecPlace As Long, AppVer
As String, _
oAddin As AddIn, Counter As
Long, AddinFileArray() As String
ReDim AddinFileArray(100)
'--------------------
'Get the application version
DecPlace = InStr(Application.Version, ".")
AppVer = Left$(Application.Version, DecPlace + 1)
'--------------------
'Get the "Office installation folder startup path" by adding "Startup\" to the
Program path
WrongStartupPath = System.PrivateProfileString("", _
"HKEY_CURRENT_USER\Software\Microsoft\Office\" & AppVer &
"\Word\Options", "ProgramDir")
'--------------------
If Not Right$(WrongStartupPath, 1) = "\"
Then
WrongStartupPath = WrongStartupPath & "\"
End If
WrongStartupPath = WrongStartupPath & "Startup" & "\"
'--------------------
AddinFileArray(0) = Dir$(WrongStartupPath & "*.dot")
'--------------------
'Quit if no files found
If Len(AddinFileArray(0)) = 0
Then Exit Sub
'--------------------
'If files found, get all their names and put them into an array
Do While Not Len(AddinFileArray(Counter)) =
0
AddinFileArray(Counter) = AddinFileArray(Counter)
Counter = Counter + 1
AddinFileArray(Counter) = Dir$
Loop
'--------------------
ReDim Preserve
AddinFileArray(Counter - 1)
'Now delete or move all add-ins found in the wrong Startup
path
For Counter = 0 To
UBound(AddinFileArray)
'First unload the add-in _
(Resume Next in case the user has removed it using Tools +
Templates and Add-ns
On Error Resume Next
Set oAddin =
AddIns(WrongStartupPath & AddinFileArray(Counter))
If oAddin.Installed
Then
oAddin.Installed =
False
oAddin.Delete
End If
On Error GoTo 0
'--------------------
'Check whether the same file is also in the correct startup
path
If
Len(Dir$(Options.DefaultFilePath(wdStartupPath) & "\" & _
AddinFileArray(Counter))) > 0 Then
'It's in both
paths, so delete the file that's in the wrong path
KillProperly Killfile:=WrongStartupPath
& AddinFileArray(Counter)
Else
'It's only in
the wrong path, so move it to the right one and then reload it
FileCopy WrongStartupPath &
AddinFileArray(Counter), _
Options.DefaultFilePath(wdStartupPath) & "\" & AddinFileArray(Counter)
KillProperly Killfile:=WrongStartupPath
& AddinFileArray(Counter)
AddIns.Add
Options.DefaultFilePath(wdStartupPath) & "\" & AddinFileArray(Counter)
End If
Next Counter
End Sub
Public Sub KillProperly(Killfile As String)
If Len(Dir$(Killfile)) > 0
Then
SetAttr KillFile, vbNormal
Kill KillFile
End If
End Sub
The reason that the KillProperly subroutine is required, as opposed to just using the Kill statement, is covered in the article: How to delete files using VBA, including files which may be readonly.
If you want to be really safe (and if you plan to store the above code in an add-in, rather than in Normal.dot), you could call it like this:
Public Sub AutoExec()
If LCase$(ThisDocument.Path) =
LCase$(Options.DefaultFilePath(wdStartupPath)) Then
Call
EnsureAddinsInCorrectPath
End If
End Sub
That ensures that if a copy of the add-in that contains this code somehow finds its way into the wrong startup path, the add-in won't try to delete itself.