clear or empty office clipboard form Excel VBA

photonblaster · Oct 12, 2005

I came back to a common problem of clearing the office clipboard from Excel VBA (I have WXP, Office 2003 all updates and service packe) to see if there are any elegant solutions posted on this message board, and found none. In fact, I found that many people suggesting help to clearing the clipboard gave help on clearing the windows clipboard rather than the Office clipboard. I did not even see a solution to this issue (at least something that I rcoginized as a solution, forgive me if I missed one), elegant or otherwise, so I am posting the solution I have so people can use it as they see fit, and to see if anyone has improvement suggestions or other methods of doing it.

I especially would like to know what code I could add to automatically open the clipboard, since the code only seems to work if the clipboard is open.
Of course, if someone has 10 lines of code that will empty the clipboard, I would love to see this rather than using this big module.

I am far from an expert on the solution I have, since, after litterally days of googling I found this solution concept on Guoqiang Wu's Blog. According to him, the "handle" (or whatever the technical term is) to access the office clipboard can change as you open and close Excel (or any office program). So you have to search for the handle first, and then send the appropriate signal to the clipboard. Mr. Wu was kind enough to help me modify his implementation so that the search function results gets cached, and any subsequent calls to the clear clipboard function bypasses the search and just clears the clipboard. I am very much indebted to him since clearing the clipboard was a do or die for my project.

Here is my implementation.
to clear the clipboard from within vba just put the code line
ClearOfficeClipboard.

You should run it at least once during any initialization phase of your code so that the overhead for finding the clipboard "handle" does not slow you up latter when you need fast execution.

Also, this is real pain in the whatever,but for this code to work, the clipboard must be visible!!!! I have not found a work around this. And I can't even find a way to make the clipboard visible from within vba, so I have to do it manually! I just minimize the window size and after months of use I do not even notice it there, but talk about brute force! However, since my project will not execute quickly enough without emptying the clipboard frequently of all the garbage it collects that sucks up memory and really slows things down.

Clear the Clipboard Module: ( I just commented out things when I changed them from Mr. Wu's original version that is more generic since it was supposed to work from any office application).

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

'Global objButton As AccObject
'Dim accButton As AccObject

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

'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

'Using Active Accessibility to clear Office clipboard
'Assumption:
' this is running within Word or Excel as a macro, thus the global Application object is available
Sub ClearOfficeClipboard()
 Static accButton As AccObject
 If accButton.objIA Is Nothing Then
 Dim fShown As Boolean
 fShown = CommandBars("Task Pane").Visible
 wsRAW_DATA.Select
 Range("A1").Copy
 bSuccess = oAIX.Sleep(2000)
 If Not (fShown) Then
 CommandBars("Task Pane").Enabled = True
 CommandBars("Task Pane").Visible = True
 ' MsgBox ("Press OK and Open Clipboard , then F5 to continue or you will get an error message")
 End If
 ' CommandBars("Task Pane").Visible = True
 ' WordBasic.EditOfficeClipboard '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
 accButton = FindAccessibleChildInWindow(GetOfficeClipboardHwnd(Application), "Clear All", ROLE_PUSHBUTTON)
 ' CommandBars("Task Pane").Visible = fShown
 ' CommandBars("Task Pane").Visible = False
 End If
 If accButton.objIA Is Nothing Then
 MsgBox "Unable to locate the ""Clear All"" button!"
 Else
 accButton.objIA.accDoDefaultAction accButton.lngChild
 End If
End Sub

''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
'' Dim 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

[/b]

photonblaster · Oct 13, 2005

Thank you both so much for you help, I will do some more testing and post results. Tesitng so far indicates so far that the clipboard windowclass can get un-loaded under certain cercumstances that the code does not handle, details when I am done testing.

photonblaster · Oct 13, 2005

Thank you both so much for you help

I have been able to make Joe's code work for me, with some modifications. I will try to say what I did using the right buzz words, forgive me if I misuse them.
My testing indicates that the clipboard windows class name (hCLip variable) does NOT remain loaded if you clear the clipboard when it is not visible, or if you close an empty clipboard. It does remian loaded if the clipboard remains visible. It does remain loaded if you just close the clipboard without clearing it out.

So I modified the code to always force the closed clipboard to go through the visible-not visible steps to give it a loaded class name that we can find, and we have to find it in order to send the clear clipboard mouse click commands through PostMessage.

Since I will call this sub thousands of times, and execution speed is tremendously important to my project, I captured first time through so some static variable initializations do not have to be done more than once. A second "first time through" capture bypassed evaluating hClip if the clipboard has remained visible.

The code as previously written can change the state of ScreenUpdating if it is called from other code where screen updating is off, so I added a check for this.

I am assuming that the references to api clipboard functions are to control the windows clipboard, not the Office clipboard, since they seemed to do nothing to the status of the Office Clipboard, so I deleted those. (???did I do the right thing?)

This code now works with the clipboard viewer open or closed (at least for me), but it gives screen flicker when the clipboard is closed, even though the screen updating turned off. It is very visible if you put the ClearOfficeClipboard sub call in a loop. The flicker is so bad It makes my project non-functional as far as a user is concerned, so I am back to having to keep the clipboard open.

Any suggestions on how to eliminate the flicker?

Also, Mr. Wu's code, which seems to clear the clipboard from any Office product while this one is specific to Excel, uses the default action for the "Clear All" button rather than psuedo mouse clicks through PostMessage. The default button action would seem to be more self-contained within VBA (and more elegant?) but I can't see how to merge this concept with this code. His code line, in my original post, is
accButton.objIA.accDoDefaultAction accButton.lngChild
I get no flicker when I use my modified version of his code. Is it possilbe that the flicker is related to the method of "pushing" the clear all button?

Here is the modification of Joe's code:
Option Explicit

Sub myClr()
'Put this sub inta a Sheet Module, like: Sheet1.
 Call ClearOfficeClipboard
End Sub

'Put the code from here down into a Standard Module, like Module1.
Private Declare Function FindWindowEx Lib "user32.dll" _
 Alias "FindWindowExA" (ByVal hWnd1 As Long, _
 ByVal hWnd2 As Long, ByVal lpsz1 As String, _
 ByVal lpsz2 As String) As Long
Private Declare Function PostMessage Lib "user32.dll" Alias _
 "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
 ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const WM_LBUTTONDOWN As Long = &H201&
Private Const WM_LBUTTONUP As Long = &H202&

'creates a long variable out of two words
Private Function MakeLong(ByVal nLoWord As Integer, ByVal nHiWord As Integer) As Long
 MakeLong = nHiWord * 65536 + nLoWord
End Function

Sub ClearOfficeClipboard()
 Dim hMain&, hExcel2&, hWindow&, hParent&
 Static sTask As String
 ' Dim hClip As Long 'changed by Lary
 Dim octl, bScreenUpdatingIsOn As Boolean
 Static lParameter As Long, bNotFirstVisibleTime As Boolean, hClip As Long, bNotFirstTime As Boolean

 If Not (bNotFirstTime) Then
 lParameter = MakeLong(120, 18)
 sTask = Application.CommandBars("Task Pane").NameLocal
 'Handle for XLMAIN
 hMain = Application.hwnd
 bNotFirstTime = True
 End If

 With Application.CommandBars("Task Pane")

 If Not .Visible Then
 'assume have to force the window if it is not visible, since it appears that
 ' the window class does not remain loaded if you clear a non-visible clipboard

 'determine current status of screenupdating so that this sub does not change it
 bScreenUpdatingIsOn = Application.ScreenUpdating
 If bScreenUpdatingIsOn Then Application.ScreenUpdating = False

 Set octl = Application.CommandBars(1).FindControl(ID:=809, recursive:=True)
 If Not octl Is Nothing Then octl.Execute
 .Visible = False

 'return to screenupdating on if that is what it was in the beginning
 If bScreenUpdatingIsOn Then Application.ScreenUpdating = True

 If hClip = 0 Then
 hParent = hMain: hWindow = 0
 hWindow = FindWindowEx(hParent, hWindow, "MsoWorkPane", vbNullString)
 If hWindow Then
 hParent = hWindow: hWindow = 0
 hClip = FindWindowEx(hParent, hWindow, "bosa_sdm_XL9", vbNullString)
 End If
 End If
 Else
 If Not (bNotFirstVisibleTime) Then 'find hClip if window is visible
 Do
 hExcel2 = FindWindowEx(hMain, hExcel2, "EXCEL2", vbNullString)

 hParent = hExcel2: hWindow = 0
 hWindow = FindWindowEx(hParent, hWindow, "MsoCommandBar", sTask)
 If hWindow Then
 hParent = hWindow: hWindow = 0
 hWindow = FindWindowEx(hParent, hWindow, "MsoWorkPane", vbNullString)
 If hWindow Then
 hParent = hWindow: hWindow = 0
 hClip = FindWindowEx(hParent, hWindow, "bosa_sdm_XL9", vbNullString)
 If hClip > 0 Then
 Exit Do
 End If
 End If
 End If
 Loop While hExcel2 > 0
 bNotFirstVisibleTime = True
 End If
 End If
 End With

 If hClip = 0 Then
 MsgBox "Cant find Clipboard window"
 Exit Sub
 End If
 Call PostMessage(hClip, WM_LBUTTONDOWN, 0&, lParameter)
 Call PostMessage(hClip, WM_LBUTTONUP, 0&, lParameter)
End Sub

Joe Was · Oct 14, 2005

I tested your modification and I like it.

To address your question: "I am assuming that the references to api clipboard functions are to control the windows clipboard, not the Office clipboard, since they seemed to do nothing to the status of the Office Clipboard, so I deleted those. (???did I do the right thing?) "

The calling code below for the code I posted, should clear all the memory hogs for the copy/paste history:

1. Clear the Office Clip Board.
2. Clear the Windows Clip Board
3. Clear the last Cut/Copy/Paste cell tag.

So if you need to use all of this or not is your call. I found for my use this works well?

My original use for this was for an application that opens an e-mail [data form that lists information about job assignments] copies the info, pastes it into an Excel database scheduling system. Then CLEARS all the copy/paste history setting up the application for importing the next assignment or information updating the progress of an existing job.

So I needed it all!

Sub myClr()
'Sheet Module Code, like: Sheet1.

Call ClearOfficeClipboard
apiOpenClipboard (0)
apiEmptyClipboard
apiCloseClipboard
Application.CutCopyMode = False
End Sub

photonblaster · Oct 14, 2005

Thanks for the extra explanation, I understand now. I probably would only benifit from clearing the last Cut/Copy/Paste cell tag in this project, so I will use that.

Forgot to mention that sleeps and doevents are controlled in my main routine, so I did not need these in this sub either, so my posted code removed those too.

Also forgot to mention that this code solved an issue I had before too...now I can modify it to automatically open the clipboard window and leave it open rather than having to remember to open it manually. Sure wish I could leave it closed without flicker though!

Thanks again! I'll move on to the next phase of my project now.

clear or empty office clipboard form Excel VBA

photonblaster

New Member

photonblaster

New Member

Excel Facts

photonblaster

New Member

Joe Was

MrExcel MVP

photonblaster

New Member

Similar threads

Forum statistics

Share this page

clear or empty office clipboard form Excel VBA

photonblaster

New Member

photonblaster

New Member

Excel Facts

photonblaster

New Member

Joe Was

MrExcel MVP

photonblaster

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock