How do I clear the copy clipboard using VBA?

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

When I use the DoCmd copy record function in VBA I'm getting a message box
asking whetehter I want to paste date when I close the form. How do I clear
the clipboard buffer to eliminate this message?
 
Richk said:
When I use the DoCmd copy record function in VBA I'm getting a
message box asking whetehter I want to paste date when I close the
form. How do I clear the clipboard buffer to eliminate this message?
Click to expand...

You can call the Windows API EmptyClipboard function. Just paste the
following into a standard module:

'----- start of code -----
Private Declare Function apiOpenClipboard Lib "User32" _
Alias "OpenClipboard" _
(ByVal hWnd As Long) _
As Long

Private Declare Function apiEmptyClipboard Lib "User32" _
Alias "EmptyClipboard" _
() As Long

Private Declare Function apiCloseClipboard Lib "User32" _
Alias "CloseClipboard" _
() As Long


Function EmptyClipboard()

If apiOpenClipboard(0&) <> 0 Then
Call apiEmptyClipboard
Call apiCloseClipboard
End If

End Function
'----- end of code -----

Then just execute

EmptyClipboard

when you want to empty the clipboard.
 
Hi
Here are all the clipboard functions
(not my code, I have had these so long I don't know where they came from
most likely Dev (http://www.mvps.org/access/) ot Stephen Lebans
(http://www.lebans.com/)

Enjoy

Bruce



Module: basClipboard
--------------------------------------------------
Option Compare Database
Option Explicit

Declare Function clt_OpenClipboard Lib "user32" Alias "OpenClipboard" (ByVal
hwnd As Long) As Long
Declare Function clt_GetClipboardData Lib "user32" Alias "GetClipboardData"
(ByVal wFormat As Long) As Long
Declare Function clt_GlobalAlloc Lib "kernel32" Alias "GlobalAlloc" (ByVal
wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function clt_GlobalLock Lib "kernel32" Alias "GlobalLock" (ByVal
hMem As Long) As Long
Declare Function clt_lstrCpy Lib "kernel32" Alias "lstrcpyA" (ByVal
lpString1 As Any, ByVal lpString2 As Any) As Long
Declare Function clt_GlobalUnlock Lib "kernel32" Alias "GlobalUnlock" (ByVal
hMem As Long) As Long
Declare Function clt_CloseClipboard Lib "user32" Alias "CloseClipboard" ()
As Long
Declare Function clt_SetClipboardData Lib "user32" Alias "SetClipboardData"
(ByVal wFormat As Long, ByVal hMem As Long) As Long
Declare Function clt_EmptyClipBoard Lib "user32" Alias "EmptyClipboard" ()
As Long

' --------------------------------------------------------------
' Comments : Designer Function used to open queries in QBE
' that are in DoCmd.OpenQuery statements in code
' Could be a sub but you can't call subs from macros
' Parameters: None
' Returns : None
' --------------------------------------------------------------

Function GetClipboardData_clt() As String
On Error GoTo Err_GetClipboardData_clt
' Comments : Returns the text contents of the clipboard
' Parameters: None
' Returns : string
Dim lngClipMemory As Long
Dim lngHandle As Long
Dim strTemp As String
Dim lngTemp As Long
Dim strNew As String
Dim intCounter As Integer
Dim chrTmp As String * 1

If clt_OpenClipboard(0&) <> 0 Then
lngHandle = clt_GetClipboardData(1)
If Not IsNull(lngHandle) Then
lngClipMemory = clt_GlobalLock(lngHandle)
If Not IsNull(lngClipMemory) Then
strTemp = Space$(4096)
lngTemp = clt_lstrCpy(strTemp, lngClipMemory)
lngTemp = clt_GlobalUnlock(lngHandle)

For intCounter = 1 To Len(strTemp)
chrTmp = Mid$(strTemp, intCounter, 1)
If chrTmp <> vbNullChar Then
strNew = strNew & chrTmp
End If
Next intCounter
strTemp = Trim(strNew)
Else
MsgBox "Could not lock memory to copy string from."
End If
End If
lngTemp = clt_CloseClipboard()
End If

GetClipboardData_clt = strTemp
exit_GetClipboardData_clt:
Exit Function
Err_GetClipboardData_clt:
On Error Resume Next
lngTemp = clt_CloseClipboard()
GetClipboardData_clt = ""
On Error GoTo 0
Resume exit_GetClipboardData_clt
End Function

Function ClearClipboardData_clt() As Boolean
On Error GoTo err_ClearClipboardData_clt
' Comments : Clears the clipboard
' Parameters: None
' Returns : True if successful, False otherwise
Dim lngTemp As Long

If clt_OpenClipboard(0&) <> 0 Then
lngTemp = clt_EmptyClipBoard()
lngTemp = clt_CloseClipboard()
End If

ClearClipboardData_clt = True
exit_ClearClipboardData_clt:
Exit Function
err_ClearClipboardData_clt:
ClearClipboardData_clt = False
Resume exit_ClearClipboardData_clt
End Function

Function SetClipboardData_clt(strText As String) As Boolean
On Error GoTo err_SetClipboardData_clt
' Comments : Writes the supplied string to the clipboard
' Parameters: strText - text to write
' Returns : True if successful, False otherwise
Dim lngHoldMem As Long
Dim lngGlobalMem As Long
Dim lngClipMem As Long
Dim lngTemp As Long

lngHoldMem = clt_GlobalAlloc(&H42, Len(strText) + 1)
lngGlobalMem = clt_GlobalLock(lngHoldMem)
lngGlobalMem = clt_lstrCpy(lngGlobalMem, strText)
If clt_GlobalUnlock(lngHoldMem) = 0 Then
If clt_OpenClipboard(0&) <> 0 Then
lngTemp = clt_EmptyClipBoard()
lngClipMem = clt_SetClipboardData(1, lngHoldMem)
lngTemp = clt_CloseClipboard()
End If
End If

SetClipboardData_clt = True
exit_SetClipboardData_clt:
Exit Function
err_SetClipboardData_clt:
SetClipboardData_clt = False
Resume exit_SetClipboardData_clt
End Function



--------------------------------------------------
 
Back
Top