关于excel：VBA跟踪哪些工作簿是打开的

VBA keep track of which workbooks are open

VBA 如何跟踪打开的工作簿？

我正在编写一个数据挖掘宏，它从可变数量的工作簿中获取信息。用户可以通过用户表单选择将解析哪些工作簿。但是，可以在用户窗体运行时打开和关闭工作簿。
那么，我的用户窗体如何跟踪打开的工作簿，以便准确显示它们。

现在，我正在使用一个递归函数，它通过"Application.OnTime"调用自身。我真的不喜欢这个解决方案，因为它涉及额外检查以查看用户窗体是否仍然打开，以及由于调用函数的任何时间段而导致延迟。

Final：答案和评论的组合解决方案
用户表单代码，需要一个名为 WorkbookList 的 ListBox 和一个名为 FileTextBox

的文本框

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

Private WithEvents App As Application

Public Sub WorkbookList_UpdateList()
WorkbookList.Clear

For Each Wb In Application.Workbooks
WorkbookList.AddItem Wb.name
Next Wb
End Sub

Private Sub WorkbookList_Change()
If WorkbookList.ListIndex = -1 Then Exit Sub

key = WorkbookList.List(WorkbookList.ListIndex)

For Each Wb In Application.Workbooks
IsWorkBookOpen Wb.path
If Wb.name = key Then FileTextbox.text = Wb.path
Next Wb
End Sub

Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
WorkbookList_UpdateList
End Sub

Private Sub App_NewWorkbook(ByVal Wb As Workbook)
WorkbookList_UpdateList
End Sub

Private Sub App_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
Application.OnTime Now + TimeValue("00:00:01"),"WorkbookClosed"
End Sub

Private Sub UserForm_Initialize()
Set App = Application
WorkbookList_UpdateList
UpdatePeriodicly
End Sub

模块代码(把它放在一个vba模块中)：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

'Code From: http://www.ozgrid.com/forum/showthread.php?t=152892
Function IsUserFormLoaded(ByVal UFName As String) As Boolean
Dim UForm As Object

IsUserFormLoaded = False
For Each UForm In VBA.UserForms
If UForm.name = UFName Then
IsUserFormLoaded = True
Exit For
End If
Next
End Function

Public Sub WorkbookClosed()
If IsUserFormLoaded("InputForm") = False Then Exit Sub
InputForm.WorkbookList_UpdateList
End Sub

相关讨论

您可以为此使用应用程序事件。

例如请参阅 cpearson.com/excel/appevent.aspx

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

Private WithEvents app As Excel.Application

Sub Init()
Set app = Application 'start capturing events
End Sub

Private Sub app_NewWorkbook(ByVal Wb As Workbook)
Debug.Print"New"
End Sub

Private Sub app_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
Debug.Print"Before close:" & Wb.Name
End Sub

Private Sub app_WorkbookOpen(ByVal Wb As Workbook)
Debug.Print"Open:" & Wb.Name
End Sub

所以我认为这是一个有趣的脚本，并且可能对您试图解决的问题有用。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

Public Function IsWorkBookOpen(FileName As String)

Dim ff As Long, ErrNo As Long

On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0

Select Case ErrNo
Case 0: IsWorkBookOpen = False 'Workbook IS NOT
Case 70: IsWorkBookOpen = True 'Workbook IS open
Case Else: Error ErrNo
End Select
End Function

你可以这样调用它

1 2	Ret = IsWorkBookOpen("C:\\test.xlsm") If Ret = True Then 'YOUR CODE HERE