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
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
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
' 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
CopyUnicodeToClipboard strPath
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
you should also Change the Font so it will match the Hyperlink font displayed on the Form.For that I used this hacky solution.
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.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
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
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.
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
RemoveReference "MSForms"
I was curious as to whether it could be removed.I use API code similar to that @arnelgp got from ChatGPT though with fewer APIs.
For example, see my example app:
![]()
SQL to/from VBA Converter Add-In
This Access add-in is an updated version of my SQL to VBA And Back Again utility which makes it easy to convert query SQL to a VBA string (or vice versa). Additonal functionality includes creating example code from the VBA string and temp queries to test the SQL / VBA output.www.isladogs.co.uk
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
which we know does not work.
Option 1: Remove MSForms Reference Manually
- Open the Access database.
- Press Alt + F11 to open the VBA editor.
- Go to Tools > References.
- Find "Microsoft Forms 2.0 Object Library".
- Uncheck the box next to it.
- Click OK.
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
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?