Vba 正在迭代未注册的加载项（.xla）

我需要帮助

• 了解如何使用

  Tools>add-ins

  菜单路径迭代当前打开的、尚未在Excel中注册的Excel加载项文件（.xla）
• 更具体地说，我对任何没有出现在“加载项”对话框中，但有

  thiswoolk.IsAddin=True

  的工作簿都感兴趣

说明问题：

尝试按如下方式循环浏览工作簿不会获得带有

的工作簿。AddIn=True

：

Dim book As Excel.Workbook

For Each book In Application.Workbooks
    Debug.Print book.Name
Next book

通过外接程序循环不会获得未注册的外接程序：

Dim addin As Excel.AddIn

For Each addin In Application.AddIns
    Debug.Print addin.Name
Next addin

在VBProjects集合中循环工作，但仅当用户在宏安全设置中具有对Visual Basic项目的特定受信任访问权限时才起作用-这很少：

Dim vbproj As Object

For Each vbproj In Application.VBE.VBProjects
    Debug.Print vbproj.Filename
Next vbproj

但是，如果已知工作簿的名称，则无论工作簿是否为加载项，都可以直接引用该工作簿：

Dim book As Excel.Workbook
Set book = Application.Workbooks("add-in.xla")

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Public Function GetAllOpenWorkbooks() As Collection

'Retrieves a collection of all open workbooks and add-ins.

Const EXCEL_APPLICATION_WINDOW  As String = "XLDESK"
Const EXCEL_WORKBOOK_WINDOW     As String = "EXCEL7"

Dim hWnd                As Long
Dim hWndExcel           As Long
Dim contentLength       As Long
Dim buffer              As String
Dim bookName            As String
Dim books               As Collection

Set books = New Collection

'Find the main Excel window
hWndExcel = FindWindowEx(Application.hWnd, 0&, EXCEL_APPLICATION_WINDOW, vbNullString)

Do

    'Find next window
    hWnd = FindWindowEx(hWndExcel, hWnd, vbNullString, vbNullString)

    If hWnd Then

        'Create a string buffer for 100 chars
        buffer = String$(100, Chr$(0))

        'Get the window class name
        contentLength = GetClassName(hWnd, buffer, 100)

        'If the window found is a workbook window
        If Left$(buffer, contentLength) = EXCEL_WORKBOOK_WINDOW Then

            'Recreate the buffer
            buffer = String$(100, Chr$(0))

            'Get the window text
            contentLength = GetWindowText(hWnd, buffer, 100)

            'If the window text was returned, get the workbook and add it to the collection
            If contentLength Then
                bookName = Left$(buffer, contentLength)
                books.Add Excel.Application.Workbooks(bookName), bookName
            End If

        End If

    End If

Loop While hWnd

'Return the collection
Set GetAllOpenWorkbooks = books

End Function

---

但是，如果名称未知，并且用户的宏安全设置无法依赖，如何获取对该工作簿的引用呢？

我仍在寻找解决此问题的合理解决方案，但目前看来，阅读所有工作簿窗口的窗口文本可以获得所有打开工作簿的集合，是否添加：

Dim book As Excel.Workbook
Set book = Application.Workbooks("add-in.xla")

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Public Function GetAllOpenWorkbooks() As Collection

'Retrieves a collection of all open workbooks and add-ins.

Const EXCEL_APPLICATION_WINDOW  As String = "XLDESK"
Const EXCEL_WORKBOOK_WINDOW     As String = "EXCEL7"

Dim hWnd                As Long
Dim hWndExcel           As Long
Dim contentLength       As Long
Dim buffer              As String
Dim bookName            As String
Dim books               As Collection

Set books = New Collection

'Find the main Excel window
hWndExcel = FindWindowEx(Application.hWnd, 0&, EXCEL_APPLICATION_WINDOW, vbNullString)

Do

    'Find next window
    hWnd = FindWindowEx(hWndExcel, hWnd, vbNullString, vbNullString)

    If hWnd Then

        'Create a string buffer for 100 chars
        buffer = String$(100, Chr$(0))

        'Get the window class name
        contentLength = GetClassName(hWnd, buffer, 100)

        'If the window found is a workbook window
        If Left$(buffer, contentLength) = EXCEL_WORKBOOK_WINDOW Then

            'Recreate the buffer
            buffer = String$(100, Chr$(0))

            'Get the window text
            contentLength = GetWindowText(hWnd, buffer, 100)

            'If the window text was returned, get the workbook and add it to the collection
            If contentLength Then
                bookName = Left$(buffer, contentLength)
                books.Add Excel.Application.Workbooks(bookName), bookName
            End If

        End If

    End If

Loop While hWnd

'Return the collection
Set GetAllOpenWorkbooks = books

End Function

那么这个呢：

Public Sub ListAddins()

Dim ai As AddIn

    For Each ai In Application.AddIns
        If Not ai.Installed Then
            Debug.Print ai.Application, ai.Parent, ai.Name, ai.FullName
        End If
    Next

End Sub

---

任何用途？

use=DOCUMENTS，一个Excel4宏函数

Dim Docs As Variant
Docs = Application.Evaluate("documents(2)")

以下是它的文档（可用）：

文档
以文本形式以水平数组的形式返回指定打开工作簿的名称（按字母顺序）。使用文档检索打开的工作簿的名称，以便在操作打开的工作簿的其他函数中使用

语法
文档（键入数量，匹配文本）
Type_num是一个数字，根据下表指定是否在工作簿数组中包含外接程序工作簿

Type_num       Returns
1 or omitted   Names of all open workbooks except add-in workbooks
2              Names of add-in workbooks only
3              Names of all open workbooks

---

Match_text指定要返回其名称的工作簿，并且可以包含通配符。如果省略match_text，文档将返回所有打开工作簿的名称。

是否可以通过注册表进行迭代？我知道，这不会让您了解Excel实例正在使用什么，而是让您了解新实例将使用什么-但取决于您需要它做什么，它可能已经足够好了

相关的关键是：

'Active add-ins are in values called OPEN*
HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\Options

'Inactive add-ins are in values of their full path
HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\Add-in Manager

---

AS Office 2010中有一个新的集合AddiS2，它与Advin相同，但也包含未注册的XLA插件。

Dim a As AddIn
Dim w As Workbook

On Error Resume Next
With Application
    For Each a In .AddIns2
        If LCase(Right(a.name, 4)) = ".xla" Then
            Set w = Nothing
            Set w = .Workbooks(a.name)
            If w Is Nothing Then
                Set w = .Workbooks.Open(a.FullName)
            End If
        End If
    Next
End With

---

我在Exel 2013（在工作环境中）上的用户

Addin

无法使用已安装（以及在VBE中）的加载项时遇到问题

从Chris C那里修补提供了一个很好的解决方法

Dim a As AddIn
Dim wb As Workbook

On Error Resume Next
With Application
    .DisplayAlerts = False
        For Each a In .AddIns2
        Debug.Print a.Name, a.Installed
            If LCase(Right$(a.Name, 4)) = ".xla" Or LCase(Right$(a.Name, 5)) Like ".xla*" Then
                Set wb = Nothing
                Set wb = .Workbooks(a.Name)
                wb.Close False
                Set wb = .Workbooks.Open(a.FullName)
            End If
        Next
   .DisplayAlerts = True
End With

---

谢谢这在4年前是非常有用的：P接受了你的答案，因为我接受的答案太粗糙了。是的，我意识到有点晚了。：-）但我遇到了同样的问题，并认为它可能会帮助其他人。不幸的是，该功能在现代版本的Excel中不再有效（至少在2010年，尽管我认为Microsoft至少在Excel 2007年之前取消了对Excel 4功能的支持）。