使用计时器来获得Excel标题

我有以下代码来获得当前打开的Excel文件的标题这个代码工作正常。 如果标题改变，则每10秒钟使用计时器，然后在列表1中添加新标题。

所以问题是否有任何方法或事件来检测标题是否改变，然后我的代码工作，否则不工作不检查。 定时器检查每10秒我的电脑工作缓慢，如果我运行这个代码

Private Const GW_HWNDNEXT = 2 Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, _ ByVal wCmd As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName 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 Sub ListWins(Optional Title = "*", Optional Class = "*") Dim hWndThis As Long hWndThis = FindWindow(vbNullString, vbNullString) While hWndThis Dim sTitle As String, sClass As String sTitle = Space$(255) sTitle = Left$(sTitle, GetWindowText(hWndThis, sTitle, Len(sTitle))) sClass = Space$(255) sClass = Left$(sClass, GetClassName(hWndThis, sClass, Len(sClass))) If sTitle Like Title And sClass Like Class Then Debug.Print sTitle, sClass List1.AddItem (sTitle) End If hWndThis = GetWindow(hWndThis, GW_HWNDNEXT) Wend End Sub Private Sub Timer1_Timer() ListWins "*.xls*" End Sub 

Answer 1

答案是No 。 AFAIK，不，在vb6中没有这样的事件，它将在Excel或任何其他窗口中标题更改。 另外不幸的是10秒计时器可能不太好。 如果标题每2秒更改一次会发生什么？ 它不会检索所有的标题

但是，尝试这种不使用定时器控制的替代scheme。 看看你的电脑是否仍然很慢…

 Sub Sample() ' ' ~~> Rest of your code ' Wait 2 '<~~ Wait for 2 seconds ' ' ~~> Rest of your code ' End Sub Private Sub Wait(ByVal nSec As Long) nSec = nSec + Timer While nSec > Timer DoEvents Wend End Sub 

Answer 2

您可以使用Excel COM API来执行此操作。 不幸的是，没有办法获得Excel的窗口标题 – 但你可以通过附加“ – Microsoft Excel”轻松制作。 如果您需要完整path，请使用FullName属性。

 Option Explicit Private WithEvents m_oApplication As Excel.Application Private Sub Command_Click() ' Get a reference to the FIRST instance of the Excel application. Set m_oApplication = GetObject(, "Excel.Application") End Sub Private Sub m_oApplication_NewWorkbook(ByVal Wb As Excel.Workbook) List1.AddItem Wb.Name End Sub Private Sub m_oApplication_WorkbookAfterSave(ByVal Wb As Excel.Workbook, ByVal Success As Boolean) 'List1.AddItem "WorkbookAfterSave: " & Wb.FullName List1.AddItem Wb.Name End Sub Private Sub m_oApplication_WorkbookOpen(ByVal Wb As Excel.Workbook) List1.AddItem Wb.Name End Sub