Copy strPath to clipboard (1 Viewer)

Danick

Registered User.
Local time
Today, 09:13
Joined
Sep 23, 2008
Messages
377
Already using a string called strPath in a VBA. Just can't figure out how to copy that strPath to the clipboard so I can just ctr-paste outside of Access.
Is there a one liner that can do this?
 
You will need Microsoft Forms 2.0 Object Library. for the above.

ChatGPT offered the same.
Code:
Sub CopyAccessToClipboard()
    Dim access As String
    access = "YourAccessValueHere"

    Dim clipboard As New MSForms.DataObject
    clipboard.SetText access
    clipboard.PutInClipboard

    MsgBox "Value copied to clipboard!"
End Sub
 
Also, check out this previous thread.
 
This works for me (found at https://stackoverflow.com/questions/72806674/how-copy-text-from-vba-to-windows-clipbaord):
Code:
Sub testCopy()
    Dim clipOb As MSForms.DataObject, str As String
    Set clipOb = New MSForms.DataObject
    str = "My Text"
    clipOb.SetText str
    clipOb.PutInClipboard
End Sub

Thanks this works. I did get an error at first and couldn't find the MS Forms reference needed to get this to work. But your link shows that it can also be added manually to the FM20.dll file located in the Windows\system32 folder. Thanks again.
 
Whilst it works, I'd suggest avoiding the use of the MSForms reference library if possible.
Its not listed as it isn't intended for use in Access

The link in post #5 gives one such alternative.
 
You can also use API to put the text from your variable into the Clipboard.
Copy/paste in a Module:
Code:
' CHATGPT

#If VBA7 Then
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As LongPtr, Source As Any, ByVal Length As LongPtr)
#Else
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function EmptyClipboard Lib "user32" () As Long
    Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
    Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, Source As Any, ByVal Length As Long)
#End If

Private Const CF_UNICODETEXT As Long = 13
Private Const GMEM_MOVEABLE As Long = &H2

Sub CopyUnicodeToClipboard(sText As String)
    Dim hMem As LongPtr, pMem As LongPtr
    Dim byteLength As Long

    byteLength = LenB(sText) + 2 ' Unicode needs 2 bytes per char + null terminator

    If OpenClipboard(0&) Then
        EmptyClipboard
        hMem = GlobalAlloc(GMEM_MOVEABLE, byteLength)
        If hMem Then
            pMem = GlobalLock(hMem)
            If pMem Then
                CopyMemory pMem, ByVal StrPtr(sText), byteLength
                GlobalUnlock hMem
                SetClipboardData CF_UNICODETEXT, hMem
            End If
        End If
        CloseClipboard
    End If
End Sub

to put strPath to Clipboard:
Code:
CopyUnicodeToClipboard strPath
 
For most copying I use MS Forms object like everyone else. However there are times where I want to paste a formatted hyperlink that pastes with display text rather than the target url. I could never get it to work with the MS Forms 2.0 object. For that I used this hacky solution.

Code:
Public Sub CopyHyperlinkToClipboard(linkUrl As String, Optional linkText As String = "")

    Dim ie As Object ' As InternetExplorer
    Dim htmlDoc As Object ' As HTMLDocument

    ' Create a hidden IE instance
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = False

    ' Navigate to a blank page
    ie.Navigate "about:blank"
    Do While ie.Busy Or ie.ReadyState <> 4
        DoEvents
    Loop

    Set htmlDoc = ie.Document

    ' Insert your HTML hyperlink
    htmlDoc.body.InnerHTML = "<a href='" & linkUrl & "' " & _
                             "style='font-family:Segoe UI; font-size:10pt; color:blue; text-decoration:underline;'>" & _
                             linkText & "</a>"

    ' Give the browser a moment to render (usually not strictly required, but just to be safe)
    DoEvents

    ' Focus the document (sometimes necessary)
    htmlDoc.parentWindow.Focus

    ' Select all content in the document
    htmlDoc.ExecCommand "SelectAll", False, 0

    ' Copy the selection to the clipboard
    htmlDoc.ExecCommand "Copy", False, 0

    ' Quit IE
    ie.Quit
    Set ie = Nothing

    ' Now the hyperlink with formatting should be on the clipboard.
End Sub
 
One aside for this - I too use the MS Forms object - but , however, it does not work if the conrol you are copying from has data that has ever been encrypted. And no I don't know why!
 
Last edited:
I use API code similar to that @arnelgp got from ChatGPT though with fewer APIs.
For example, see my example app:

Coming back to my earlier point, if you ever load the MSForms reference, you cannot delete it again even if its never used.
For example, the I created a blank database (attached) and added the reference. That's all

Trying to remove the reference, results in this message

1752132432597.png
 

Attachments

Last edited:
I use API code similar to that @arnelgp
Coming back to my earlier point, if you ever load the MSForms reference, you cannot delete it again even if its never used.
For example, the I created a blank database (attached) and added the reference. That's all

Trying to remove the reference, results in this message

View attachment 120530
I think I had this problem and solved it by removing the reference in code. I may even have done it by linking to the offending database from another. This is, however, dredging back in memory so I may be wrong.
 
Last edited:
i found a code that does not require reference to Microsoft Form 2.0 Object.
The code comes from:
Code:
Function Clipboard$(Optional s$)
    Dim v: v = s  'Cast to variant for 64-bit VBA support
    With CreateObject("htmlfile")
        With .parentWindow.clipboardData
            Select Case True
                Case Len(s): .setData "text", v
                Case Else:   Clipboard = .getData("text")
            End Select
        End With
    End With
End Function

another one:
Code:
Sub CopyText(ByVal Text As String)
    'VBA Macro using late binding to copy text to clipboard.
    'By Justin Kay, 8/15/2014
    Dim MSForms_DataObject As Object
    Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    MSForms_DataObject.SetText Text
    MSForms_DataObject.PutInClipboard
    Set MSForms_DataObject = Nothing
End Sub
 
I think I had this problem and solved it by removing the reference in code. I may even have done it by linking to the offending database from another. This is, however, dredging back in memory so I may be wrong.

You can remove it using code either from an external db or the current db as its not actually in use despite the message shown earlier.

This is the code I use to remove references from the current database
Error handling manages the situation where the reference is actually in use.

Code:
Sub RemoveReference(strName As String)

On Error GoTo Err_Handler

    Dim ref As Variant, I As Long

     'Remove specified reference
    For I = Application.References.Count To 1 Step -1
        Set ref = Application.VBE.ActiveVBProject.References.Item(I)
        If ref.Name = strName Then
            Application.VBE.ActiveVBProject.References.Remove ref
        End If
    Next I
    
Exit_Handler:
        Exit Sub
    
Err_Handler:
    'If an error was encountered, inform the user
    Select Case Err.Number
    Case 13
        Resume Next
    Case Else
         'An unknown error was encountered, so alert the user
        MsgBox "A problem was encountered trying to" & vbNewLine _
        & "remove a reference from this file" & vbNewLine & "Please check the " _
        & "references in your VBA project!", vbCritical + vbOKOnly, "Error!"
    End Select
    On Error GoTo 0
End Sub

In this case

Code:
RemoveReference "MSForms"
 
Last edited:
I use API code similar to that @arnelgp got from ChatGPT though with fewer APIs.
For example, see my example app:

Coming back to my earlier point, if you ever load the MSForms reference, you cannot delete it again even if its never used.
For example, the I created a blank database (attached) and added the reference. That's all

Trying to remove the reference, results in this message

View attachment 120530
I was curious as to whether it could be removed.
ChatGPT supplied the code below, though it did offer removing it using

🧩 Option 1: Remove MSForms Reference Manually​


  1. Open the Access database.
  2. Press Alt + F11 to open the VBA editor.
  3. Go to Tools > References.
  4. Find "Microsoft Forms 2.0 Object Library".
  5. Uncheck the box next to it.
  6. Click OK.
which we know does not work. :)


Code:
Sub RemoveMSFormsReference()
    Dim app As Object
    Dim ref As Object
    Dim i As Integer

    ' Open the target Access database
    Set app = CreateObject("Access.Application")
    app.OpenCurrentDatabase "C:\Path\To\Your\Database.accdb"

    ' Loop through the references and remove MSForms
    For i = app.VBE.References.Count To 1 Step -1
        Set ref = app.VBE.References(i)
        If InStr(1, ref.Description, "Forms 2.0", vbTextCompare) > 0 Or _
           InStr(1, ref.FullPath, "FM20.DLL", vbTextCompare) > 0 Then
            app.VBE.References.Remove ref
            Exit For
        End If
    Next i

    ' Save and close
    app.Quit
    Set app = Nothing

    MsgBox "MSForms reference removed."
End Sub
which falls over at For i = app.VBE.References.Count To 1 Step -1

Edit: And in the meantime Colin posts working code. :-)
 
Sorry about that. I was out earlier when @DickyP posted and uploaded working code on my return

Thanks for the correction. Just removed the unwanted 's' at the end of post #15

Other related reference code available here:
 
Last edited:
Anyone have any idea as to why one cannot just remove this reference, like one can for others?
 
This thread inspired me to explore the issues I had with the API approach for copying a formatted hyperlink to the clipboard. After having ChatGPT 04-mini-high and Gemini 2.5 pro work together for a bit, I finally ended up with this. ChatGPT ended up solving a lot more than Gemini.

Upon testing this appears to be fully working for both plain text and html, including both showing correctly in the clipboard history with WIN+V, as well as hyperlinks pasting fully formatted in word, outlook, etc, while pasting the plaintext url in apps like notepad.

Code:
Option Explicit

'--- API Declarations for 32/64 bit ---
#If VBA7 Then
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal uFormat As Long, ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
    Private Declare PtrSafe Function RegisterClipboardFormatA Lib "user32" (ByVal lpszFormat As String) As Long
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Function lstrcpyW Lib "kernel32" (ByVal lpString1 As LongPtr, ByVal lpString2 As LongPtr) As LongPtr
#Else
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function EmptyClipboard Lib "user32" () As Long
    Private Declare Function SetClipboardData Lib "user32" (ByVal uFormat As Long, ByVal hMem As Long) As Long
    Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
    Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function RegisterClipboardFormatA Lib "user32" (ByVal lpszFormat As String) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function lstrcpyW Lib "kernel32" (ByVal lpString1 As LongPtr, ByVal lpString2 As LongPtr) As LongPtr
#End If

'--- Constants ---
Private Const GMEM_MOVEABLE As Long = &H2
Private Const CF_UNICODETEXT As Long = 13

'========================================================================================
'   PUBLIC FUNCTION: COPY PLAIN TEXT
'========================================================================================
Public Sub CopyPlainText(ByVal TextToCopy As String)
    Dim hMem As LongPtr, pMem As LongPtr, bytesToCopy As LongPtr
    ' Calculate Unicode byte count (chars+null)*2
    bytesToCopy = (Len(TextToCopy) + 1) * 2
    If OpenClipboard(0) Then
        EmptyClipboard
        hMem = GlobalAlloc(GMEM_MOVEABLE, bytesToCopy)
        If hMem <> 0 Then
            pMem = GlobalLock(hMem)
            If pMem <> 0 Then
                ' Copy full Unicode string
                lstrcpyW pMem, StrPtr(TextToCopy)
                GlobalUnlock hMem
                SetClipboardData CF_UNICODETEXT, hMem
            End If
        End If
        CloseClipboard
    End If
End Sub

'========================================================================================
'   PUBLIC FUNCTION: COPY HYPERLINK
'========================================================================================
Public Sub CopyHyperlink(ByVal URL As String, ByVal DisplayText As String)
    Dim sHtml As String
    Dim cfHTML As Long

    cfHTML = RegisterClipboardFormatA("HTML Format")
    If cfHTML = 0 Then Exit Sub

    sHtml = CreateHtmlClipboardString(URL, DisplayText)

    If OpenClipboard(0) Then
        EmptyClipboard
        ' Set Unicode URL for history and plain-text apps
        Dim hMem As LongPtr, pMem As LongPtr, byteCount As LongPtr
        byteCount = (Len(URL) + 1) * 2
        hMem = GlobalAlloc(GMEM_MOVEABLE, byteCount)
        If hMem <> 0 Then
            pMem = GlobalLock(hMem)
            If pMem <> 0 Then
                lstrcpyW pMem, StrPtr(URL)
                GlobalUnlock hMem
                SetClipboardData CF_UNICODETEXT, hMem
            End If
        End If
        ' Set HTML link for rich-text apps
        SetClipboardHtmlData sHtml, cfHTML
        CloseClipboard
    End If
End Sub

'========================================================================================
'   PRIVATE HELPER FUNCTIONS
'========================================================================================
Private Function CreateHtmlClipboardString(ByVal sURL As String, ByVal sText As String) As String
    Dim sFragment As String, sHeader As String, sBody As String
    Dim startHTML As Long, endHTML As Long, startFrag As Long, endFrag As Long
    Const ph = "00000000"

    sFragment = "<a href='" & sURL & "'>" & sText & "</a>"
    sBody = "<html><body><!--StartFragment-->" & sFragment & "<!--EndFragment--></body></html>"
    sHeader = "Version:0.9" & vbCrLf & _
              "StartHTML:" & ph & vbCrLf & _
              "EndHTML:" & ph & vbCrLf & _
              "StartFragment:" & ph & vbCrLf & _
              "EndFragment:" & ph & vbCrLf

    startHTML = LenB(StrConv(sHeader, vbFromUnicode))
    endHTML = startHTML + LenB(StrConv(sBody, vbFromUnicode))
    startFrag = startHTML + LenB(StrConv("<html><body><!--StartFragment-->", vbFromUnicode))
    endFrag = startFrag + LenB(StrConv(sFragment, vbFromUnicode))

    sHeader = Replace(sHeader, "StartHTML:" & ph, "StartHTML:" & Format(startHTML, ph))
    sHeader = Replace(sHeader, "EndHTML:" & ph, "EndHTML:" & Format(endHTML, ph))
    sHeader = Replace(sHeader, "StartFragment:" & ph, "StartFragment:" & Format(startFrag, ph))
    sHeader = Replace(sHeader, "EndFragment:" & ph, "EndFragment:" & Format(endFrag, ph))

    CreateHtmlClipboardString = sHeader & sBody
End Function

Private Sub SetClipboardHtmlData(ByVal HtmlData As String, ByVal cfFormat As Long)
    Dim b() As Byte, hMem As LongPtr, pMem As LongPtr, cnt As LongPtr
    b = StrConv(HtmlData & vbNullChar, vbFromUnicode)
    cnt = UBound(b) - LBound(b) + 1
    hMem = GlobalAlloc(GMEM_MOVEABLE, cnt)
    If hMem <> 0 Then
        pMem = GlobalLock(hMem)
        If pMem <> 0 Then CopyMemory ByVal pMem, b(LBound(b)), cnt: GlobalUnlock hMem: SetClipboardData cfFormat, hMem
    End If
End Sub

'========================================================================================
'   TEST PROCEDURES
'========================================================================================
Public Sub TestCopyPlainText()
    CopyPlainText "This is plain text."
    Debug.Print "Plain-text copied."
End Sub

Public Sub TestCopyHyperlink()
    CopyHyperlink "url goes here", "Go to Example Url"
    Debug.Print "Hyperlink copied."
End Sub
 
Anyone have any idea as to why one cannot just remove this reference, like one can for others?

Not directly.
Access won't allow you to remove any query that is in use, either from the References dialog or using code
For example, you cannot remove the built-in VBA reference automatically included in any new database by either method

The MSForms reference behaves as though it is in use when trying to remove it from the References dialog
However, it can be removed using code, provided it isn't actually being used (as in my simple example database)
 

Users who are viewing this thread

Back
Top Bottom