I might find time later to split the code and explain it by parts. For now, it is all in one here:
Option Explicit
Const CHILDID_SELF = 0&
Const ROLE_TITLEBAR = &H1&
Const ROLE_MENUBAR = &H2&
Const ROLE_SCROLLBAR = &H3&
Const ROLE_GRIP = &H4&
Const ROLE_SOUND = &H5&
Const ROLE_CURSOR = &H6&
Const ROLE_CARET = &H7&
Const ROLE_ALERT = &H8&
Const ROLE_WINDOW = &H9&
Const ROLE_CLIENT = &HA&
Const ROLE_MENUPOPUP = &HB&
Const ROLE_MENUITEM = &HC&
Const ROLE_TOOLTIP = &HD&
Const ROLE_APPLICATION = &HE&
Const ROLE_DOCUMENT = &HF&
Const ROLE_PANE = &H10&
Const ROLE_CHART = &H11&
Const ROLE_DIALOG = &H12&
Const ROLE_BORDER = &H13&
Const ROLE_GROUPING = &H14&
Const ROLE_SEPARATOR = &H15&
Const ROLE_TOOLBAR = &H16&
Const ROLE_STATUSBAR = &H17&
Const ROLE_TABLE = &H18&
Const ROLE_COLUMNHEADER = &H19&
Const ROLE_ROWHEADER = &H1A&
Const ROLE_COLUMN = &H1B&
Const ROLE_ROW = &H1C&
Const ROLE_CELL = &H1D&
Const ROLE_LINK = &H1E&
Const ROLE_HELPBALLOON = &H1F&
Const ROLE_CHARACTER = &H20&
Const ROLE_LIST = &H21&
Const ROLE_LISTITEM = &H22&
Const ROLE_OUTLINE = &H23&
Const ROLE_OUTLINEITEM = &H24&
Const ROLE_PAGETAB = &H25&
Const ROLE_PROPERTYPAGE = &H26&
Const ROLE_INDICATOR = &H27&
Const ROLE_GRAPHIC = &H28&
Const ROLE_STATICTEXT = &H29&
Const ROLE_TEXT = &H2A&
Const ROLE_PUSHBUTTON = &H2B&
Const ROLE_CHECKBUTTON = &H2C&
Const ROLE_RADIOBUTTON = &H2D&
Const ROLE_COMBOBOX = &H2E&
Const ROLE_DROPLIST = &H2F&
Const ROLE_PROGRESSBAR = &H30&
Const ROLE_DIAL = &H31&
Const ROLE_HOTKEYFIELD = &H32&
Const ROLE_SLIDER = &H33&
Const ROLE_SPINBUTTON = &H34&
Const ROLE_DIAGRAM = &H35&
Const ROLE_ANIMATION = &H36&
Const ROLE_EQUATION = &H37&
Const ROLE_BUTTONDROPDOWN = &H38&
Const ROLE_BUTTONMENU = &H39&
Const ROLE_BUTTONDROPDOWNGRID = &H3A&
Const ROLE_WHITESPACE = &H3B&
Const ROLE_PAGETABLIST = &H3C&
Const ROLE_CLOCK = &H3D&
Type tGUID
lData1 As Long
nData2 As Integer
nData3 As Integer
abytData4(0 To 7) As Byte
End Type
Type AccObject
objIA As IAccessible
lngChild As Long
End Type
Const WM_GETTEXT = &HD
Public lngChild As Long, strClass As String, strCaption As String
Declare Function AccessibleObjectFromWindow Lib "oleacc" _
(ByVal hWnd As Long, ByVal dwId As Long, _
riid As tGUID, ppvObject As Object) As Long
Declare Function AccessibleChildren Lib "oleacc" _
(ByVal paccContainer As IAccessible, ByVal iChildStart As Long, _
ByVal cChildren As Long, rgvarChildren As Variant, _
pcObtained As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Declare Function EnumChildWindows Lib "user32" (ByVal hwndParent _
As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, _
ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, ByVal lpClass As String, ByVal lpCaption As String) As Long
'Retrieve window class name
Function GetWndClass(ByVal hWnd As Long) As String
Dim buf As String, retval As Long
buf = Space(256)
retval = GetClassName(hWnd, buf, 255)
GetWndClass = Left(buf, retval)
End Function
'Retrieve window title
Function GetWndText(ByVal hWnd As Long) As String
Dim buf As String, retval As Long
buf = Space(256)
retval = SendMessage(hWnd, WM_GETTEXT, 255, buf)
GetWndText = Left(buf, InStr(1, buf, Chr(0)) - 1)
End Function
'The call back function used by EnumChildWindows
Function EnumChildWndProc(ByVal hChild As Long, ByVal lParam As Long) As Long
Dim found As Boolean
EnumChildWndProc = -1
If strClass > "" And strCaption > "" Then
found = StrComp(GetWndClass(hChild), strClass, vbTextCompare) = 0 And _
StrComp(GetWndText(hChild), strCaption, vbTextCompare) = 0
ElseIf strClass > "" Then
found = (StrComp(GetWndClass(hChild), strClass, vbTextCompare) = 0)
ElseIf strCaption > "" Then
found = (StrComp(GetWndText(hChild), strCaption, vbTextCompare) = 0)
Else
found = True
End If
If found Then
lngChild = hChild
EnumChildWndProc = 0
Else
EnumChildWndProc = -1
End If
End Function
'Find the window handle of a child window based on its class and titie
Function FindChildWindow(ByVal hParent As Long, Optional cls As String = "", Optional title As String = "") As Long
lngChild = 0
strClass = cls
strCaption = title
EnumChildWindows hParent, AddressOf EnumChildWndProc, 0
FindChildWindow = lngChild
End Function
'Retrieve the IAccessible interface from a window handle
'Reference:Jean Ross,Chapter 17: Accessibility in Visual Basic,Advanced Microsoft Visual Basic 6.0, 2nd Edition
Function IAccessibleFromHwnd(hWnd As Long) As IAccessible
Dim oIA As IAccessible
Dim tg As tGUID
Dim lReturn As Long
' Define the GUID for the IAccessible object
' {618736E0-3C3D-11CF-810C-00AA00389B71}
With tg
.lData1 = &H618736E0
.nData2 = &H3C3D
.nData3 = &H11CF
.abytData4(0) = &H81
.abytData4(1) = &HC
.abytData4(2) = &H0
.abytData4(3) = &HAA
.abytData4(4) = &H0
.abytData4(5) = &H38
.abytData4(6) = &H9B
.abytData4(7) = &H71
End With
' Retrieve the IAccessible object for the form
lReturn = AccessibleObjectFromWindow(hWnd, 0, tg, oIA)
Set IAccessibleFromHwnd = oIA
End Function
'Recursively looking for a child with specified accName and accRole in the accessibility tree
Function FindAccessibleChild(oParent As IAccessible, strName As String, lngRole As Long) As AccObject
Dim lHowMany As Long
Dim avKids() As Variant
Dim lGotHowMany As Long, i As Integer
Dim oChild As IAccessible
FindAccessibleChild.lngChild = CHILDID_SELF
If oParent.accChildCount = 0 Then
Set FindAccessibleChild.objIA = Nothing
Exit Function
End If
lHowMany = oParent.accChildCount
ReDim avKids(lHowMany - 1) As Variant
lGotHowMany = 0
If AccessibleChildren(oParent, 0, lHowMany, avKids(0), lGotHowMany) <> 0 Then
MsgBox "Error retrieving accessible children!"
Set FindAccessibleChild.objIA = Nothing
Exit Function
End If
'To do: the approach described in http://msdn.microsoft.com/msdnmag/issues/0400/aaccess/default.aspx
' are probably better and more reliable
On Error Resume Next
For i = 0 To lGotHowMany - 1
If IsObject(avKids(i)) Then
If StrComp(avKids(i).accName, strName) = 0 And avKids(i).accRole = lngRole Then
Set FindAccessibleChild.objIA = avKids(i)
Exit For
Else
Set oChild = avKids(i)
FindAccessibleChild = FindAccessibleChild(oChild, strName, lngRole)
If Not FindAccessibleChild.objIA Is Nothing Then
Exit For
End If
End If
Else
If StrComp(oParent.accName(avKids(i)), strName) = 0 And oParent.accRole(avKids(i)) = lngRole Then
Set FindAccessibleChild.objIA = oParent
FindAccessibleChild.lngChild = avKids(i)
Exit For
End If
End If
Next i
End Function
Function FindAccessibleChildInWindow(hwndParent As Long, strName As String, lngRole As Long) As AccObject
Dim oParent As IAccessible
Set oParent = IAccessibleFromHwnd(hwndParent)
If oParent Is Nothing Then
Set FindAccessibleChildInWindow.objIA = Nothing
Else
FindAccessibleChildInWindow = FindAccessibleChild(oParent, strName, lngRole)
End If
End Function
'Using Active Accessibility to clear Office clipboard
'Input: app - the application object of an Office application
'Assumption: Clipboard task pane is shown in the Office application (app object)
Function ClearOfficeClipboard(app As Object) As Boolean
Dim oButton As AccObject, fShow As Boolean
'Get the IAccessible interface and child id (wrapped in the AccObject type)
'Notice: the second parameter, accName "Clear All" is localized!
'You can find out the accName and accRole using Spy, Inspect32 or other tools
oButton = FindAccessibleChildInWindow(GetOfficeClipboardHwnd(app), "Clear All", ROLE_PUSHBUTTON)
If oButton.objIA Is Nothing Then
MsgBox "Unable to locate the ""Clear All"" button!"
ClearOfficeClipboard = False
Else
oButton.objIA.accDoDefaultAction oButton.lngChild
ClearOfficeClipboard = True
End If
End Function
'Generic routine to retrieve the window handle of the active window of an Office Application
Function GetOfficeAppHwnd(app As Object) As Long
GetOfficeAppHwnd = FindWindow(vbNullString, GetOfficeAppWindowTitle(app))
End Function
'Retrieve the window handle of the task pane
'Notice: the task pane window title is localized!
'You can find out the window class and title using Spy, Inspect32 or other tools
Function GetOfficeTaskPaneHwnd(app As Object) As Long
GetOfficeTaskPaneHwnd = FindChildWindow(GetOfficeAppHwnd(app), _
"MsoCommandBar", "Task Pane")
End Function
'Retrieve the window handle of the clipboard child window inside task pane
'The window title of the clipboard window seems to be language independent,
'making it a better start point to searching our UI element than the task pane window
Function GetOfficeClipboardHwnd(app As Object) As Long
GetOfficeClipboardHwnd = FindChildWindow(GetOfficeAppHwnd(app), , "Collect and Paste 2.0")
End Function
'Generic routine to retrieve the window title of the active window of an Office application
Function GetOfficeAppWindowTitle(app As Object) As String
On Error GoTo ErrorHandler
Select Case app.Name
Case "Microsoft Word"
GetOfficeAppWindowTitle = app.ActiveWindow.Caption & " - " & app.Name
Case Else
GetOfficeAppWindowTitle = app.Name & " - " & app.ActiveWindow.Caption
End Select
Exit Function
ErrorHandler:
MsgBox "Unsupported Office application!"
GetOfficeAppWindowTitle = ""
End Function
The above code will only work on the English version of Office. For other languages, you need find the correct value for three strings that may be localized:
1) The caption of the Clipboard Task Pane window. In English, it is "Task Pane";
2) The caption of the window containing all those clipboard control buttons and item lists. It is also a direct child of the "Task Pane" window. The English equivalent is "Collect and Paste 2.0";
3) The accName of the "Clear All" button.
You can use SPY or Inspect32/AccExplorer32 from MSAA SDK tools to find out 1) and 2). You can not get 3) from SPY. But most likely it is the shown localized caption of the "Clear All" button. You could confirm that with Inspect32/AccExplorer32.
