VBA跟踪哪些工作簿已打开

VBA如何跟踪哪些工作簿打开?

我正在写一个数据挖掘macros,从可变数量的工作簿中获取信息。 用户可以select将通过用户窗体parsing的工作簿。 但是,可以在用户窗体运行时打开和closures工作簿。
那么,我的用户表单如何跟踪哪些工作簿已打开,以便能够准确显示它们。

现在,我正在使用一个recursion函数,它自己调用“Application.OnTime”。 我不太喜欢这个解决scheme,因为它涉及额外的检查,看看用户表单是否仍然打开,以及由于该函数被调用的任何时间段而有延迟。

最后: 答案和评论的综合解决scheme
用户表单代码,需要名为WorkbookList的ListBox和名为FileTextBox的文本框

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模块中):

 '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

 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 

所以我认为这是一个有趣的脚本,可能对你想解决的问题有用。

 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 

你可以通过做这样的事情来调用它

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