Issues with clearing the clipboard using VBA

[RawlinsCross]

Found some code online that purports to clear the clipboard... but I'm getting a error I can't decipher. Wonder if anyone has a solution.

'In a separate module

#If VBA7 Then
Private Declare PtrSafe Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, _
ByVal iChildStart As Long, ByVal cChildren As Long, _
ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
Public Const myVBA7 As Long = 1
#Else
Private Declare PtrSafe Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, _
ByVal iChildStart As Long, ByVal cChildren As Long, _
ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
Public Const myVBA7 As Long = 0
#End If
Public Sub EvRClearOfficeClipBoard()
'On Error Resume Next
Dim cmnB, IsVis As Boolean, j As Long, Arr As Variant

Arr = Array(4, 7, 2, 0) '4 and 2 for 32 bit, 7 and 0 for 64 bit
Set cmnB = Application.CommandBars("Office Clipboard")
With Application
    .DisplayClipboardWindow = True
End With
IsVis = cmnB.Visible
If Not IsVis Then
    cmnB.Visible = True
    DoEvents
End If
For j = 1 To Arr(0 + myVBA7)
    AccessibleChildren cmnB, Choose(j, 0, 3, 0, 3, 0, 3, 1), 1, cmnB, 1
Next
cmnB.accDoDefaultAction CLng(Arr(2 + myVBA7)) '<---- Fails here (see error snippit below)
Application.CommandBars("Office Clipboard").Visible = IsVis
With Application
    .DisplayClipboardWindow = True
End With
'On Error GoTo 0
End Sub

This is the error I'm getting :

 

[NdNoviceHlp]

Module code...

#If VBA7 And Win64 Then
Public Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Public Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Public Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
#Else
'Open the clipboard to read
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
'Close the clipboard
Public Declare Function CloseClipboard Lib "user32" () As Long
#End If

To operate....

OpenClipboard (0&)
EmptyClipboard
CloseClipboard

HTH. Dave

 

[RawlinsCross]

Hey Dave.. .my aplogies for the delayed response. It seems to be working, I'll keep an eye on it as the old code worked sometimes and didn't work others. I like that yours is so succinct. Thanks again.

John

 

[NdNoviceHlp]

You are welcome. Thanks for posting your outcome. Dave

 

[RawlinsCross]

The code is now bugging out with the following error

I'm trying to copy a userform and paste it in the body of an Outlook email. I will try to be as succinct as I can with the code

Clear Clipboard Module

[/B]

#If VBA7 And Win64 Then
Public Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Public Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Public Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
#Else
'Open the clipboard to read
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
'Close the clipboard
Public Declare Function CloseClipboard Lib "user32" () As Long
#End If

[B]

Calling the code above to clear the clipboard before pasting it in the body of an outlook email. (code is truncated for clarity)

'Clear ClipBoard
OpenClipboard (0&)
EmptyClipboard
CloseClipboard

Call EmailEmployeeDecision(sCommentVac, sCommentFloat, sSubject, sRecipient, sEmailCat, Me)

Attempting to copy the userform and paste it in outlook email

Public Sub EmailEmployeeDecision(sCommentVac As String, sCommentFloat As String, sSubject As String, sRecipient As String, sEmailCat As String, frm As Object)

Dim olApp As Outlook.Application
Dim OutMail As Object
Dim wordDoc As Object

'Self-healing objects
Dim OutApp  As Object
Set OutApp = OutlookApp()

'Test if outlook if open
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
On Error GoTo 0

If olApp Is Nothing Then
    Set olApp = CreateObject("Outlook.Application")
End If

Set OutMail = OutApp.CreateItem(0)
Set wordDoc = OutMail.GetInspector.WordEditor

If sEmailCat = "Vac" Then
    'Capture Userform
    DoEvents
    frm.tbSF.SetFocus
    frm.MultiPage1.value = 0
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    DoEvents

    'Paste picture
    wordDoc.Range(0, 0).PasteAndFormat 0 '<------ Error happens here
    wordDoc.InlineShapes(1).Height = 200
    wordDoc.InlineShapes(1).Width = 300
    wordDoc.Range(0, 0).InsertAfter vbNewLine & vbNewLine
    wordDoc.Range(0, 0).InsertAfter sCommentVac
    wordDoc.Range(0, 0).InsertAfter vbNewLine

'code continues.....

 

[RawlinsCross]

From CPearson's page on the subject:

"The Public Declare lines of code need to be in the declarations section of the module, before and outside of any procedure."

Is my problem due to this? If so, I do not understand what he's meaning here.

 

[NdNoviceHlp]

RawlingsCross are you emptying the clipboard before you use it instead of vice versa? OR does the e-mail keyevents copy the userform? What happens if you don't run the Cliboard code? What happens if you run it afterwards? Chip meant that you need to place the clipboard code at the top (declarations section) of a module declaring it as public so it is available to the rest of your wb. You may have to copy the userform before you start your outlook. Keep up with the great research. Dave

 

[RawlinsCross]

I am emptying the clipboard before using the keyevents to copy the userform - is this not the logically way to do it (i.e. empty then place)?

 

[NdNoviceHlp]

print a Userform

Hi Is there a way to print a Userform? I made one using about 25 command buttons and would like to make a hard copy I probably would only have to do it once mike

www.mrexcel.com

module code...

#If VBA7 Then
    Private Declare PtrSafe Sub keybd_event Lib "user32" _
        (ByVal bVk As Byte, ByVal bScan As Byte, _
         ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
#Else
    Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
       bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#End If
    
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12 '''

Public Sub AltPrintScreen()
        keybd_event VK_MENU, 0, 0, 0
        keybd_event VK_SNAPSHOT, 0, 0, 0
        keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
        keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
End Sub

so....

'etc
Set OutMail = OutApp.CreateItem(0)
Set wordDoc = OutMail.GetInspector.WordEditor

If sEmailCat = "Vac" Then
    'Capture Userform
    DoEvents
    frm.tbSF.SetFocus
    frm.MultiPage1.value = 0
   ' keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
   ' keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
   ' keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
  '  keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
   Call AltPrintScreen
    DoEvents
'etc

Trial this instead. Manually, it's ctrl + alt + prtscr.
Dave

 

[RawlinsCross]

So all these various solutions on the code-side work for a bit and then give the same error as above. I have not tried sending the userform to the clipboard BEFORE involving Outlook. I'll try that next - but if it works, there's no guarantee that it will not work further down the line. Okay, so I'll try the "outside Oulook" idea and then test the hell out of it. I'll report back when I'm done.

UPDATE: That won't work, I need to have the userform clipboard copy insider the outlook subroutine as I might be pasting in a couple of userforms and i would then need to place them appropriately within the WordEditor. Ugh... lol