Where are add-ins normally stored?

Microsoft Office applications can load add-ins from any location in the file-system. When you try to store the application add-ins (.ppa, .ppam, .xla,  .xlam, etc.), they do propose that you store it at a particular location. This location is relative to AppData folder and also dependent on the locale. The GetAddInsFolder() function given below returns the Add-Ins folder in any Windows version and in any locale:

Public Const KEY_READ = &H20019
Public Const HKEY_CURRENT_USER = &H80000001
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" _
    Alias "RegOpenKeyExA" ( _
        ByVal hKey As Long, _
        ByVal lpSubKey As String, _
        ByVal ulOptions As Long, _
        ByVal samDesired As Long, _
        phkResult As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" _
    Alias "RegQueryValueExA" ( _
        ByVal hKey As Long, _
        ByVal lpValueName As String, _
        ByVal lpReserved As Long, _
        lpType As Long, _
        ByVal lpData As String, _
        lpcbData As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" ( _
    ByVal hKey As Long) As Long

Function GetAddInsFolder() As String
    Dim Key As String
    Dim Path As String
    Dim L As Long
    Dim HK As Long

    On Error Resume Next

    Key = "Software\Microsoft\Office\" + Application.Version + _
        "\Common\General"
    RegOpenKeyEx HKEY_CURRENT_USER, Key, 0, KEY_READ, HK
    L = 0
    RegQueryValueEx HK, "AddIns", 0, 0, vbNullString, L
    Path = Space(L)
    RegQueryValueEx HK, "AddIns", 0, 0, Path, L
    RegCloseKey HK
    GetAddInsFolder = Environ("AppData") + "\Microsoft\" + Path
End Function

Contact OfficeOne on email at officeone@officeoneonline.com. Copyright © 2001-2023 OfficeOne. All rights reserved.