Clipboard copy VBA code not working in Windows 10

nagovind · Jan 26, 2018

Dear All,

While working in Windows 7 this code was working in Excel 2013
But this same code is not working in Windows 10 and returns ASCI code ??

Interesting fact is if 2 more windows explorer (folders) are open this error appears
If the windows explorer (folders) are closed this same code is working well

Kindly advise the common solution to fix this

Code:

Dim objClipBoard As Object
Dim texttobecopied As String
MSForms.DataObject
Set objClipBoard = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

lt = Application.ActiveCell.Address
kk = ActiveCell.Row
tt = "AT" & kk
'ActiveSheet.Range(tt) = "'VR'" & ActiveSheet.Name & "'!" & lt

texttobecopied = "='" & ActiveSheet.Name & "'!" & lt

With objClipBoard
.SetText texttobecopied
.PutInClipboard
End With

End Sub

Regards
Govind

Chihiro · Jan 26, 2018

As far as I know. There isn't CLSID for Clipboard in Win 10.

May be something was changed. Check with MS.

Edit: I mean MS Forms x.x DataObject.

Edit2: I don't have Windows 10 machine. But you can try searching for the entry in "Regedit" and see if you can locate the CLSID for it.

nagovind · Jan 26, 2018

Chihiro said:
As far as I know. There isn't CLSID for Clipboard in Win 10.

May be something was changed. Check with MS.

Edit: I mean MS Forms x.x DataObject.

Thank you for your reply
But the same code is working in Windows 10 if all open FOLDERS/ WINDOWS EXPLORER are closed

Regards
Govind

Chihiro · Jan 26, 2018

I can't remember the details, but I recall there being issue with Windows 10, Folder/file explorer. If I recall, fix had something to do with Winsock.

You may have better luck asking in MS forums/support. Since the issue isn't with the code itself, but the environment.

Debaser · Jan 29, 2018

The CLSID is correct, this is just a bug in Win8 and later. You should use Windows API calls instead.

For example, add this to a new module:

Code:

Option Explicit
#If Mac Then
    ' ignore
#Else
    #If VBA7 Then
        Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
        Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
        Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
                                                             ByVal dwBytes As LongPtr) As LongPtr

        Declare PtrSafe Function CloseClipboard Lib "User32" () As Long
        Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As LongPtr) As LongPtr
        Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long

        Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
                                                         ByVal lpString2 As Any) As LongPtr

        Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat _
                                                                As Long, ByVal hMem As LongPtr) As LongPtr
    #Else
        Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
        Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
        Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
                                                     ByVal dwBytes As Long) As Long

        Declare Function CloseClipboard Lib "User32" () As Long
        Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
        Declare Function EmptyClipboard Lib "User32" () As Long

        Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
                                                 ByVal lpString2 As Any) As Long

        Declare Function SetClipboardData Lib "User32" (ByVal wFormat _
                                                        As Long, ByVal hMem As Long) As Long
    #End If
#End If
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096

Sub ClipBoard_SetData(MyString As String)
    #If Mac Then
        With New MSForms.DataObject
            .SetText MyString
            .PutInClipboard
        End With
    #Else
        #If VBA7 Then
            Dim hGlobalMemory As LongPtr
            Dim hClipMemory   As LongPtr
            Dim lpGlobalMemory    As LongPtr
        #Else
            Dim hGlobalMemory As Long
            Dim hClipMemory   As Long
            Dim lpGlobalMemory    As Long
        #End If

        Dim x                 As Long

        ' Allocate moveable global memory.
        '-------------------------------------------
        hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)

        ' Lock the block to get a far pointer
        ' to this memory.
        lpGlobalMemory = GlobalLock(hGlobalMemory)

        ' Copy the string to this global memory.
        lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)

        ' Unlock the memory.
        If GlobalUnlock(hGlobalMemory) <> 0 Then
            MsgBox "Could not unlock memory location. Copy aborted."
            GoTo OutOfHere2
        End If

        ' Open the Clipboard to copy data to.
        If OpenClipboard(0&) = 0 Then
            MsgBox "Could not open the Clipboard. Copy aborted."
            Exit Sub
        End If

        ' Clear the Clipboard.
        x = EmptyClipboard()

        ' Copy the data to the Clipboard.
        hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere2:

        If CloseClipboard() = 0 Then
            MsgBox "Could not close Clipboard."
        End If
    #End If

End Sub

then call it like this:

Code:

ClipBoard_SetData "your text here"

kilaka · May 7, 2019

thank you, this worked for me!

Julianne.Sauer · Jun 10, 2020

>>> use code - tags <<<

Code:

Option Explicit
#If Mac Then
    ' ignore
#Else
    #If VBA7 Then
        Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
        Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
        Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
                                                             ByVal dwBytes As LongPtr) As LongPtr

        Declare PtrSafe Function CloseClipboard Lib "User32" () As Long
        Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As LongPtr) As LongPtr
        Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long

        Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
                                                         ByVal lpString2 As Any) As LongPtr

        Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat _
                                                                As Long, ByVal hMem As LongPtr) As LongPtr
    #Else
        Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
        Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
        Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
                                                     ByVal dwBytes As Long) As Long

        Declare PtrSafe Function CloseClipboard Lib "User32" () As Long
        Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
        Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long

        Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
                                                 ByVal lpString2 As Any) As Long

        Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat _
                                                        As Long, ByVal hMem As Long) As Long
    #End If
#End If
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096

Sub ClipBoard_SetData(MyString As String)
    #If Mac Then
        With New MSForms.DataObject
            .SetText MyString
            .PutInClipboard
        End With
    #Else
        #If VBA7 Then
            Dim hGlobalMemory As LongPtr
            Dim hClipMemory   As LongPtr
            Dim lpGlobalMemory    As LongPtr
        #Else
            Dim hGlobalMemory As Long
            Dim hClipMemory   As Long
            Dim lpGlobalMemory    As Long
        #End If

        Dim x                 As Long

        ' Allocate moveable global memory.
        '-------------------------------------------
        hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)

        ' Lock the block to get a far pointer
        ' to this memory.
        lpGlobalMemory = GlobalLock(hGlobalMemory)

        ' Copy the string to this global memory.
        lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)

        ' Unlock the memory.
        If GlobalUnlock(hGlobalMemory) <> 0 Then
            MsgBox "Could not unlock memory location. Copy aborted."
            GoTo OutOfHere2
        End If

        ' Open the Clipboard to copy data to.
        If OpenClipboard(0&) = 0 Then
            MsgBox "Could not open the Clipboard. Copy aborted."
            Exit Sub
        End If

        ' Clear the Clipboard.
        x = EmptyClipboard()

        ' Copy the data to the Clipboard.
        hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere2:

        If CloseClipboard() = 0 Then
            MsgBox "Could not close Clipboard."
        End If
    #End If

End Sub

Thank you. It worked for me. But I added PtrSafe before Functions to run.

---

Best Regards!

Hannah J. Parrish -

- A clean and safe home

Debaser · Jun 18, 2020

That won't compile in versions pre-2010. Those PtrSafe statements in the #Else section should not be there.

Julianne.Sauer · Jun 19, 2020

>>> the 2nd time -- USE CODE - TAGS <<<

Code:

I used in VBA 2010 excel, and red color at
#Else
        Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
        Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
        Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
                                                     ByVal dwBytes As Long) As Long

        Declare Function CloseClipboard Lib "User32" () As Long
        Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
        Declare Function EmptyClipboard Lib "User32" () As Long

        Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
                                                 ByVal lpString2 As Any) As Long

        Declare Function SetClipboardData Lib "User32" (ByVal wFormat _
                                                        As Long, ByVal hMem As Long) As Long
    #End If

Debaser · Jun 19, 2020

Yes, the compiler colours it red, but the code still works as that part won't run in 2010 or later. However, if you try and use your code in 2007 or earlier, it will fail.

Julianne.Sauer · Jun 19, 2020

No no, it's not running, not working in 2010!!!

Debaser · Jun 19, 2020

Then something else is wrong, because what you have posted is not correct.

nagovind · Jun 19, 2020

Kindly do the needful
The code is not working and it is showing red

Is it possible to embed the first thread of the code into this and share the excel sheet to run the code

Please
Govind narayan

Chihiro · Jun 19, 2020

Red color doesn't mean anything in itself without context.

Since it's nested within #Else #End If statement, That part of code isn't used when your System is using VBA7.

As Debaser explained, VBA7 was introduced in Excel 2010 for compatibility with 64 bit install of Office suites. Prior to that, Office was only available in 32 bit.

So, by checking constant 'VBA7', it will use part between #If ... #Else If on 64bit Windows with 64bit Office install. Otherwise, #Else... #End If part is used.

Unless, you are using 32 bit Windows and/or Excel 2007 or older... it should not impact code execution.
If code isn't working, what's the exact error message that you get?

I tested Debaser's code on following set up and can confirm it does work as intended.
1. Win 10, Office 365, 64 bit install
2. Win 7, Office 365, 32 bit install

nagovind · Jun 19, 2020

Thank you for your reply
I need to upgrade my excel version to make it happen

regards
Govind narayan

Debaser · Jun 19, 2020

What version are you using, and what is the actual problem? Are you getting an error, or does the code do nothing, or does it do the wrong thing? That code should work in any version of Excel (other than Mac versions where it just doesn't do anything as written).

nagovind · Jun 19, 2020

Hi
Thank you for your reply
Presently I have Excel 2013

I need to run the below code

Isn't below same as in (Your) #1 Reply?
except ... then You used code - tags
>>> use code - tags <<<

Code:

Dim objClipBoard As Object
Dim texttobecopied As String
MSForms.DataObject
Set objClipBoard = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

lt = Application.ActiveCell.Address
kk = ActiveCell.Row
tt = "AT" & kk
'ActiveSheet.Range(tt) = "'VR'" & ActiveSheet.Name & "'!" & lt

texttobecopied = "='" & ActiveSheet.Name & "'!" & lt

With objClipBoard
.SetText texttobecopied
.PutInClipboard
End With

End Sub

Debaser · Jul 6, 2020

No, that is not even vaguely similar to the code I posted.

Dan Wallace · Jun 2, 2021

Debaser said:

The CLSID is correct, this is just a bug in Win8 and later. You should use Windows API calls instead.

For example, add this to a new module:

Code:

Option Explicit
#If Mac Then
    ' ignore
#Else
    #If VBA7 Then
        Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
        Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
        Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
                                                             ByVal dwBytes As LongPtr) As LongPtr

        Declare PtrSafe Function CloseClipboard Lib "User32" () As Long
        Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As LongPtr) As LongPtr
        Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long

        Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
                                                         ByVal lpString2 As Any) As LongPtr

        Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat _
                                                                As Long, ByVal hMem As LongPtr) As LongPtr
    #Else
        Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
        Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
        Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
                                                     ByVal dwBytes As Long) As Long

        Declare Function CloseClipboard Lib "User32" () As Long
        Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
        Declare Function EmptyClipboard Lib "User32" () As Long

        Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
                                                 ByVal lpString2 As Any) As Long

        Declare Function SetClipboardData Lib "User32" (ByVal wFormat _
                                                        As Long, ByVal hMem As Long) As Long
    #End If
#End If
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096

Sub ClipBoard_SetData(MyString As String)
    #If Mac Then
        With New MSForms.DataObject
            .SetText MyString
            .PutInClipboard
        End With
    #Else
        #If VBA7 Then
            Dim hGlobalMemory As LongPtr
            Dim hClipMemory   As LongPtr
            Dim lpGlobalMemory    As LongPtr
        #Else
            Dim hGlobalMemory As Long
            Dim hClipMemory   As Long
            Dim lpGlobalMemory    As Long
        #End If

        Dim x                 As Long

        ' Allocate moveable global memory.
        '-------------------------------------------
        hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)

        ' Lock the block to get a far pointer
        ' to this memory.
        lpGlobalMemory = GlobalLock(hGlobalMemory)

        ' Copy the string to this global memory.
        lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)

        ' Unlock the memory.
        If GlobalUnlock(hGlobalMemory) <> 0 Then
            MsgBox "Could not unlock memory location. Copy aborted."
            GoTo OutOfHere2
        End If

        ' Open the Clipboard to copy data to.
        If OpenClipboard(0&) = 0 Then
            MsgBox "Could not open the Clipboard. Copy aborted."
            Exit Sub
        End If

        ' Clear the Clipboard.
        x = EmptyClipboard()

        ' Copy the data to the Clipboard.
        hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere2:

        If CloseClipboard() = 0 Then
            MsgBox "Could not close Clipboard."
        End If
    #End If

End Sub

then call it like this:

Code:

ClipBoard_SetData "your text here"

This is amazing - I had given up all hope of ever getting it to work. Thank you!

Grigg21 · Feb 6, 2023

I have got rid of the issue by restarting Windows explorer.

Debaser · Feb 6, 2023

I have seen the same error with early bound code so I do not believe that is a solution.

Clipboard copy VBA code not working in Windows 10

Member

Excel Ninja

Member

Excel Ninja

Well-Known Member

New Member

New Member

Well-Known Member

New Member

Well-Known Member

New Member

Well-Known Member

Member

Excel Ninja

Member

Well-Known Member

Member

Well-Known Member

New Member

New Member

Well-Known Member