How to copy only plain text of cells in Excel? - excel

I am designing an Excel worksheet where the user will click a command button which copies a predetermined range of cells. The user would then paste the contents into a web app using Firefox or IE. The design of the web app is out of my control and currently the text boxes that are used for data input are rich text inputs. This causes the text to look odd and formatted like Excel when the user pastes into them.
Is there a way in Excel using VBA to copy only the plain text of the cells that are selected? No formatting, no tabling or cell borders, just the text and nothing else. My current workaround macro is copying the cells, opening Notepad, pasting into Notepad, and then copying from Notepad to get the plain text. This is highly undesirable and I'm hoping there's a way to do this within Excel itself. Please let me know, thanks!

Something like this?
Sheet1.Cells(1, 1).Copy
Sheet1.Cells(1, 2).PasteSpecial xlPasteValues
Or
selection.Copy
Sheet1.Cells(1,2).Activate
Selection.PasteSpecial xlPasteValues
Copy copies the entire part, but we can control what is pasted.
Same applies to Range objects as well.
EDIT
AFAIK, there is no straighforward way to copy only the text of a range without assigning it to a VBA object (variable, array, etc.). There is a trick that works for a single cell and for numbers and text only (no formulas):
Sub test()
Cells(1, 1).Select
Application.SendKeys "{F2}"
Application.SendKeys "+^L"
Application.SendKeys "^C"
Cells(1, 3).Select
Application.SendKeys "^V"
End Sub
but most developers avoid SendKeys because it can be unstable and unpredictable. For example, the code above works only when the macro is executed from excel, not from VBA. When run from VBA, SendKeys opens the object browser, which is what F2 does when pressed at the VBA view :) Also, for a full range, you will have to loop over the cells, copy them one by one and paste them one by one to the application. Now that I think better, I think this is an overkill..
Using arrays is probably better. This one is my favorite reference on how you pass ranges to vba arrays and back:
http://www.cpearson.com/excel/ArraysAndRanges.aspx
Personally, I would avoid SendKeys and use arrays. It should be possible to pass the data from the VBA array to the application, but hard to say without knowing more about the application..

Actually, the best way to do this is to copy the cells and paste into a notepad. Notepad won't recognize the cells. You can then copy the text back into whatever cell you want. This works for copying text from multiple cells into a single cell.

If you're dealing with a lot of cells to be copied, the selection.copy method will be extremely slow. (I experienced that when running a macro on 200 000 records).
A 100 times more performant way is to directly assign the value of one cell to another. Example from my code:
With errlogSheet
'Copy all data from the current row
reworkedErrorSheet.Range("A" & reworkedRow).Value = .Range("A" & currentRow).Value
reworkedErrorSheet.Range("B" & reworkedRow).Value = .Range("B" & currentRow).Value
reworkedErrorSheet.Range("C" & reworkedRow).Value = .Range("C" & currentRow).Value
reworkedErrorSheet.Range("D" & reworkedRow).Value = .Range("D" & currentRow).Value
reworkedErrorSheet.Range("E" & reworkedRow).Value = .Range("E" & currentRow).Value

Try this to copy whatever cell you have selected:
Sub CopyTheCell()
Dim TheText As String
TheText = Selection
ToClipboard TheText
End Sub
Function ToClipboard(Optional StoreText As String) As String
'PURPOSE: Read/Write to Clipboard
'Source: ExcelHero.com (Daniel Ferry)
Dim x As Variant
'Store as variant for 64-bit VBA support
x = StoreText
'Create HTMLFile Object
With CreateObject("htmlfile")
With .parentWindow.clipboardData
Select Case True
Case Len(StoreText)
'Write to the clipboard
.setData "text", x
Case Else
'Read from the clipboard (no variable passed through)
Clipboard = .GetData("text")
End Select
End With
End With
End Function

This can be easily solved without bothering with VBA.
The user can paste the contents of the clipboard by Ctrl + Shift + V instead of more usual Ctrl + V (pasting as formatted).
Ctrl + Shift + V pastes the clipboard content as plain text.

In Excel 2013 you can do this with shortcuts.
Press Ctrl + Alt + V to open the paste special window.
Now you can click the values radio button or just press V if your Excel is in English.
If you don't use Excel in English you can see which button can be pressed to select the wanted option by looking at the underlining of the single letters.
Finaly press Enter to paste your copied selection.

In Excel, highlight the cell in question.
Hit F2.
CTRL+Shift+Home. (This highlights the cell’s entire contents.)
CTRL+C.
Go to destination application.
CTRL+V.
It looks like a lot of steps, but when you actually do it, it’s much quicker than using the ribbons to accomplish the same.
If you need to copy multiple cells into an application bereft of the Paste Special… facility, then do a regular copy and paste from Excel into Notepad, and then do a copy and paste from Notepad to the destination. Cumbersome, but it works.

To accomplish this, I will copy the selected cells to clipboard, save the clipboard to a text variable, and then copy this text back to clipboard.
Copy the following into a new module and then run the last sub:
'Handle 64-bit and 32-bit Office
#If VBA7 Then
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As LongPtr, _
ByVal dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As LongPtr
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As LongPtr
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
ByVal lpString2 As Any) As LongPtr
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As LongPtr, _
ByVal hMem As LongPtr) As LongPtr
#Else
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (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 CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
ByVal lpString2 As Any) As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat _
As Long, ByVal hMem As Long) As Long
#End If
Const GHND = &H42
Const CF_TEXT = 1
Const MAXSIZE = 4096
Function ClipBoard_SetData(MyString As String)
'PURPOSE: API function to copy text to clipboard
'SOURCE: www.msdn.microsoft.com/en-us/library/office/ff192913.aspx
'Link: https://www.thespreadsheetguru.com/blog/2015/1/13/how-to-use-vba-code-to-copy-text-to-the-clipboard
#If VBA7 Then
Dim hGlobalMemory As LongPtr, lpGlobalMemory As LongPtr
Dim hClipMemory As LongPtr, x As LongPtr
#Else
Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, x As Long
#End If
'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 Function
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 Function
Function ClipBoard_GetData() As String
' Return the data in clipboard as text
' Source: https://learn.microsoft.com/en-us/office/vba/access/concepts/windows-api/retrieve-information-from-the-clipboard
#If VBA7 Then
Dim lpGlobalMemory As LongPtr, hClipMemory As LongPtr
Dim lpClipMemory As LongPtr
Dim RetVal As LongPtr
#Else
Dim lpGlobalMemory As Long, hClipMemory As Long
Dim lpClipMemory As Long
Dim RetVal As Long
#End If
Dim MyString As String
If OpenClipboard(0&) = 0 Then
MsgBox "Cannot open Clipboard. Another app. may have it open"
Exit Function
End If
' Obtain the handle to the global memory
' block that is referencing the text.
hClipMemory = GetClipboardData(CF_TEXT)
If IsNull(hClipMemory) Then
MsgBox "Could not allocate memory"
GoTo OutOfHere
End If
' Lock Clipboard memory so we can reference
' the actual data string.
lpClipMemory = GlobalLock(hClipMemory)
If Not IsNull(lpClipMemory) Then
If lpClipMemory <> 0 Then
MyString = Space$(MAXSIZE)
RetVal = lstrcpy(MyString, lpClipMemory)
RetVal = GlobalUnlock(hClipMemory)
' Peel off the null terminating character.
MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
Else
MsgBox "Clipboard is empty!"
End If
Else
MsgBox "Could not lock memory to copy string from."
End If
OutOfHere:
RetVal = CloseClipboard()
ClipBoard_GetData = MyString
End Function
Sub CopySelectedCellsAsText()
' Copy selected cells to clipboard, save the clipboard to a text variable,
' and then copy this text back to clipboard
If TypeName(Selection) <> "Range" Then Exit Sub
Selection.Copy
Dim strSelection As String
strSelection = ClipBoard_GetData
Application.CutCopyMode = False
ClipBoard_SetData strSelection
End Sub

This copied only text values from a date column, for me
Worksheets("Shee1").Cells(2, "A").Text

Related

Excel VBA "Origin" Counterpart of "Target" for Copy and Paste Events [duplicate]

If the Clipboard contains an Excel Worksheet Range, you can access that Range's Data with the DataObject Object
Can you also find the actual Source Range (ie Worksheet, Row & Column) of that Data?
Alternatively, can you find the Last Copied Range, which is indicated with a Dashed Outline Border (NOT the Selected Range)?
Preferably using Excel 2003 VBA
This code is being used in Excel 2019 64 bit to get the range of the cells on the clipboard as opposed to the contents of the cells.
fGetClipRange returns a range object for the Excel range that is cut or copied onto the clipboard, including book and sheet. It reads it directly from the clipboard using the "Link" format, and requires the ID number for this format. The ID associated with the registered formats can change, so fGetFormatId finds the current format ID from a format name. Use Application.CutCopyMode to determine whether the cells were cut or copied.
This site was useful for working with the clipboard in VBA: https://social.msdn.microsoft.com/Forums/office/en-US/ee9e0d28-0f1e-467f-8d1d-1a86b2db2878/a-clipboard-object-for-vba-including-microsoft-word?forum=worddev
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) 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 OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal lngFormat As Long) As LongPtr
Private Declare PtrSafe Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function GetClipboardFormatNameA Lib "user32" (ByVal wFormat As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
'2020-02-11 get excel copy or cut range from clipboard
Function fGetClipRange() As Range
Dim strGetClipRange As String 'return range
Dim lptClipData As LongPtr 'pointer to clipboard data
Dim strClipData As String 'clipboard data
Dim intOffset As Integer 'for parsing clipboard data
Dim lngRangeLink As Long 'clipboard format
Const intMaxSize As Integer = 256 'limit for r1c1 to a1 conversion
lngRangeLink = fGetFormatId("Link") 'we need the id number for link format
If OpenClipboard(0&) = 0 Then GoTo conDone 'could not open clipboard
lptClipData = GetClipboardData(lngRangeLink) 'pointer to clipboard data
If IsNull(lptClipData) Then GoTo conDone 'could not allocate memory
lptClipData = GlobalLock(lptClipData) 'lock clipboard memory so we can reference
If IsNull(lptClipData) Then GoTo conDone 'could not lock clipboard memory
intOffset = 0 'start parsing data
strClipData = Space$(intMaxSize) 'initialize string
Call lstrcpy(strClipData, lptClipData + intOffset) 'copy pointer to string
If strClipData = Space$(intMaxSize) Then GoTo conDone 'not excel range on clipboard
strClipData = Mid(strClipData, 1, InStr(1, strClipData, Chr$(0), 0) - 1) 'trim null character
If strClipData <> "Excel" Then GoTo conDone 'not excel range on clipboard
intOffset = intOffset + 1 + Len(strClipData) 'can't retrieve string past null character
strClipData = Space$(intMaxSize) 'reset string
Call lstrcpy(strClipData, lptClipData + intOffset) 'book and sheet next
strClipData = Mid(strClipData, 1, InStr(1, strClipData, Chr$(0), 0) - 1)
strGetClipRange = "'" & strClipData & "'!" 'get book and sheet
intOffset = intOffset + 1 + Len(strClipData) 'next offset
strClipData = Space$(intMaxSize) 'initialize string
Call lstrcpy(strClipData, lptClipData + intOffset) 'range next
strClipData = Mid(strClipData, 1, InStr(1, strClipData, Chr$(0), 0) - 1)
strGetClipRange = strGetClipRange & strClipData 'add range
strGetClipRange = Application.ConvertFormula(strGetClipRange, xlR1C1, xlA1)
Set fGetClipRange = Range(strGetClipRange) 'range needs a1 style
conDone:
Call GlobalUnlock(lptClipData)
Call CloseClipboard
End Function
'2020-02-11 clipboard format id number changes so get it from format name
Function fGetFormatId(strFormatName As String) As Long
Dim lngFormatId As Long
Dim strFormatRet As String
Dim intLength As Integer
If OpenClipboard(0&) = 0 Then Exit Function 'could not open clipboard
intLength = Len(strFormatName) + 3 'we only need a couple extra to make sure there isn't more
lngFormatId = 0 'start at zero
Do
strFormatRet = Space(intLength) 'initialize string
GetClipboardFormatNameA lngFormatId, strFormatRet, intLength 'get the name for the id
strFormatRet = Trim(strFormatRet) 'trim spaces
If strFormatRet <> "" Then 'if something is left
strFormatRet = Left(strFormatRet, Len(strFormatRet) - 1) 'get rid of terminal character
If strFormatRet = strFormatName Then 'if it matches our name
fGetFormatId = lngFormatId 'this is the id number
Exit Do 'done
End If
End If
lngFormatId = EnumClipboardFormats(lngFormatId) 'get the next used id number
Loop Until lngFormatId = 0 'back at zero after last id number
Call CloseClipboard 'close clipboard
End Function
Not directly, no - the clipboard object seems to only contain the values of the cells (though Excel obviously somehow remembers the border):
Sub testClipborard()
Dim test As String
Dim clipboard As MSForms.DataObject
Set clipboard = New MSForms.DataObject
clipboard.GetFromClipboard
test = clipboard.GetText
MsgBox (test)
End Sub
Note you will need a reference to the Microsoft Forms 2.0 Library to get this to run (and if you don't have values in the cells it will also fail).
That being said, you can try something like the following - add this to a module in the VBA editor.
Public NewRange As String
Public OldRange As String
Public SaveRange As String
Public ChangeRange As Boolean
And use the following in a sheet object
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'save previous selection
OldRange = NewRange
'get current selection
NewRange = Selection.Address
'check if copy mode has been turned off
If Application.CutCopyMode = False Then
ChangeRange = False
End If
'if copy mode has been turned on, save Old Range
If Application.CutCopyMode = 1 And ChangeRange = False Then
'boolean to hold "SaveRange" address til next copy/paste operation
ChangeRange = True
'Save last clipboard contents range address
SaveRange = OldRange
End If
End Sub
It seemingly works, but, it's also probably fairly prone to different bugs as it is attempting to get around the issues with the clipboard. http://www.ozgrid.com/forum/showthread.php?t=66773
I completely rewrote the previous answer because I needed to get other kinds of data into Excel besides ranges. The new code is more versatile, and gets different formats off the clipboard as strings. Extracting the Excel range ends up being much simpler, and I'm also using it for bitmaps and text.
The last routine gets the number for non-built-in formats. The middle routine gets the clipboard contents as a string for the specified format. The first routine parses the Excel range from this string with the split function.
'https://officeaccelerators.wordpress.com/2013/11/27/reading-data-with-format-from-clipboard/
'https://social.msdn.microsoft.com/Forums/sqlserver/en-US/ee9e0d28-0f1e-467f-8d1d-1a86b2db2878/a-clipboard-object-for-vba-including-microsoft-word?forum=worddev
#If VBA7 And Win64 Then
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongLong) As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function RegisterClipboardFormat Lib "user32.dll" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
#Else
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) 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 GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cbCopy As Long)
#End If
'test routine displays a message box with the marching ants range
'_2022_10_30
Function fTest_GetClipboardRange()
Dim rngClipboard As Range
Set rngClipboard = fGetClipboardRange
If rngClipboard Is Nothing Then
MsgBox ("No Excel range was found on the clipboard.")
ElseIf Application.CutCopyMode = xlCopy Then 'this is always copy because of sheet add
MsgBox (fGetClipboardRange.Address & " has been copied to the clipboard.")
ElseIf Application.CutCopyMode = xlCut Then
MsgBox (fGetClipboardRange.Address & " has been cut to the clipboard.")
End If
End Function
'reads excel copy-paste range from the clipboard and returns range object or nothing if not found
'_2022_03_19
Function fGetClipboardRange() As Range 'get excel copy or cut range from clipboard
Dim strClipboard As String 'raw clipboard data
Dim arrClipboard() As String 'parse into an array
Set fGetClipboardRange = Nothing 'default is nothing
strClipboard = fGetClipboardData("link") 'get the link data string
If strClipboard = "" Then Exit Function 'done if it's empty
arrClipboard = Split(strClipboard, Chr(0)) 'else parse at null characters
If arrClipboard(0) <> "Excel" Then Exit Function 'excel should be first
strClipboard = "'" & arrClipboard(1) & "'!" & arrClipboard(2) 'parse the range from the others
strClipboard = Application.ConvertFormula(strClipboard, xlR1C1, xlA1) 'convert to a1 style
Set fGetClipboardRange = Range(strClipboard) 'range needs a1 style
End Function
'read clipboard for specified format into string or null string
'_2022_03_19
Function fGetClipboardData(strFormatId As String) As String 'read clipboard into string
#If VBA7 And Win64 Then
Dim hMem As LongPtr 'memory handle
Dim lngPointer As LongPtr 'memory pointer
#Else
Dim hMem As Long 'memory handle
Dim lngPointer As Long 'memory pointer
#End If
Dim arrData() As Byte 'clipboard reads into this array
Dim lngSize As Long 'size on clipboard
Dim lngFormatId As Long 'id number, for format name
fGetClipboardData = "" 'default
lngFormatId = fGetClipboardFormat(strFormatId) 'get format
If lngFormatId <= 0 Then Exit Function 'zero if format not found
CloseClipboard 'in case clipboard is open
If CBool(OpenClipboard(0)) Then 'open clipboard
hMem = GetClipboardData(lngFormatId) 'get memory handle
If hMem > 0 Then 'if there's a handle
lngSize = CLng(GlobalSize(hMem)) 'get memory size
If lngSize > 0 Then 'if we know the size
lngPointer = GlobalLock(hMem) 'get memory pointer
If lngPointer > 0 Then 'make sure we have the pointer
ReDim arrData(0 To lngSize - 1) 'size array
CopyMemory arrData(0), ByVal lngPointer, lngSize 'data from pointer to array
fGetClipboardData = StrConv(arrData, vbUnicode) 'convert array to string
End If
GlobalUnlock hMem 'unlock memory
End If
End If
End If
CloseClipboard 'don't leave the clipboard open
End Function
'return format number form format number, format number from format name or 0 for not found
'_2022_03_19
Function fGetClipboardFormat(strFormatId As String) As Long 'verify, or get format number from format name
Dim lngFormatId As Long 'format id number
fGetClipboardFormat = 0 'default false
If IsNumeric(strFormatId) Then 'for format number
lngFormatId = CLng(strFormatId) 'use number for built in format
CloseClipboard 'in case clipboard is already open
If CBool(OpenClipboard(0)) = False Then 'done if can't open clipboard
ElseIf CBool(IsClipboardFormatAvailable(lngFormatId)) = True Then 'true if format number found
fGetClipboardFormat = lngFormatId 'return format number
End If
CloseClipboard 'don't leave the clipboard open
Else
lngFormatId = RegisterClipboardFormat(strFormatId & Chr(0)) 'else get number from format name
If (lngFormatId > &HC000&) Then fGetClipboardFormat = lngFormatId 'if valid return format number
End If
End Function

How to clear contents of clipboard?

In Excel sheet Products, in a table named Products I've example data.
I want to copy the three leftmost columns to the clipboard, next save it's contents to file, read first line from this file, copy this to the clipboard and paste to cells of another sheet Results.
Dim DataObj As DataObject
Set DataObj = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") 'or simply New DataObject
Dim strOut As String, strIn As String
With Sheets("Products").ListObjects("Products")
Union(.ListColumns(1).DataBodyRange, .ListColumns(2).DataBodyRange, .ListColumns(3).DataBodyRange).Copy 'data copied to Clipboard
End With
DataObj.GetFromClipboard
strOut = DataObj.GetText 'data copied from Clipboard to string variable
DataObj.SetText Text:=Empty
DataObj.PutInClipboard 'Clipboard clearing #1
Application.CutCopyMode = False 'Clipboard clearing #2
ClearClipboard 'Clipboard clearing #3
Open ThisWorkbook.Path & "\products.csv" For Output As #1
Print #1, strOut;
Close #1 'data saved
Open ThisWorkbook.Path & "\products.csv" For Input As #1
Line Input #1, strIn
Close #1 'data loaded
DataObj.SetText strIn
DataObj.PutInClipboard 'data copied from string variable to Clipboard
Sheets("Results").Range("A1").PasteSpecial Paste:=xlPasteValues 'data should be pasted to single row
Application.CutCopyMode = False
Yet known ClearClipboard code:
Public Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As LongPtr
Public Declare PtrSafe Function EmptyClipboard Lib "user32" () As LongPtr
Public Declare PtrSafe Function CloseClipboard Lib "user32" () As LongPtr
Sub ClearClipboard()
OpenClipboard (0&)
EmptyClipboard
CloseClipboard
End Sub
After populating the strOut variable I applied three methods of clipboard clearing to be sure it's empty. Because of loading only the first line from file to the strIn variable and pasting it to cells thru Paste or PasteSpecial method, I expect to see one row of data, meanwhile there are all the rows I had before clearing the clipboard.
You're not clearing the office clipboard (in which these 3 lines are copied)
for clearing the office clipboard:
#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 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()
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")
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))
Application.CommandBars("Office Clipboard").Visible = IsVis
End Sub

Excel VBA - Closing a specific File Explorer window out of multiple open File Explorer windows

Cell A3 contains folder path. Cells below contain file names with extensions. Upon selecting a cell below, my Excel macro opens that file's location in File Explorer and out of multiple files in that folder selects this particular one, which can be seen in Preview. When next cell containing another file name is selected on the spreadsheet, another File Explorer window opens, even though it's the same path from A3. Looking for a line of code to add which will first close the first File Explorer window, before opening a new one. The code needs to be closing that specific File Explorer window from cell A3, out of multiple open File Explorer windows. Code I have so far
UPDATE: Running below codes, but it does not close the existing opened folder, just opens yet another:
If Target.Column = 1 And Target.Row > 5 Then
Call CloseWindow
Shell "C:\Windows\explorer.exe /select," & Range("A3") & ActiveCell(1, 1).Value, vbNormalFocus 'this works, but opens NEW folder every time
and in separate Module:
'BELOW GOES WITH Public Sub CloseWindow() FROM: https://stackoverflow.com/questions/49649663/close-folder-opened-through-explorer-exe
Option Explicit
''for 64-bit Excel use
'Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
' (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Long) As LongPtr
''for 32-bit Excel use
'Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
' (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
'To make it compatible with both 64 and 32 bit Excel you can use
#If VBA7 Then
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Long) As LongPtr
#Else
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
#End If
'Note that one of these will be marked in red as compile error but the code will still run.
Const WM_SYSCOMMAND = &H112
Const SC_CLOSE = &HF060
Public Sub CloseWindow()
Dim sh As Object
Set sh = CreateObject("shell.application")
Dim w As Variant
For Each w In sh.Windows
'print all locations in the intermediate window
Debug.Print w.LocationURL
' select correct shell window by LocationURL
' If w.LocationURL = "file://sharepoint.com#SSL/DavWWWRoot/sites/folder" Then
'If w.LocationURL = "Range("M1").value" Then
If w.LocationURL = "file://K:/ppp/xx/yy/1 - zzz" Then
SendMessage w.hWnd, WM_SYSCOMMAND, SC_CLOSE, 0
End If
Next w
End Sub
UPDATE 2:
I am now thinking however, that probably the best solution would actually be not to close the file explorer and then open it, but rather for the code to identify that there is already an open file explorer window with path from cell A3 and neither close it nor open a new one, but rather just select the new file corresponding to the new cell being clicked on in already opened file explorer window with path from cell A3. Can anybody think of a way to do that?
I found an solution (not my own) that implements a WMI query against a 'Win32_Process' Class. The code here closes any explorer.exe instances. While I don't fully understand it, I did test and found it works.
Sub CloseWindow()
Dim objWMIcimv2 As Object, objProcess As Object, objList As Object
Dim intError As Integer
Set objWMIcimv2 = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objList = objWMIcimv2.ExecQuery("select * from win32_process where name='explorer.exe'")
For Each objProcess In objList
intError = objProcess.Terminate
If intError <> 0 Then Exit For
Next
Set objWMIcimv2 = Nothing
Set objList = Nothing
Set objProcess = Nothing
End Sub
This will do the job for you. If the folder is not open it will open it, otherwise it will activate it and will bring it to the front.
In case you want to select a file in the folder, you should modify this a bit and use oWinOpen.Quit to close the window and then re-open it. Shell's behavior when opening a folder simply is different from when selecting a file in the folder too.
Sub OpenFolder(strPath As String)
Dim bFolderIsOpen As Boolean
Dim oShell As Object
Dim oWinOpen As Object
Dim Wnd As Object
Set oShell = CreateObject("Shell.Application")
bFolderIsOpen = FALSE
For Each Wnd In oShell.Windows
If Wnd.Document.Folder.Self.Path = strPath Then
Set oWinOpen = Wnd
bFolderIsOpen = TRUE
End If
Next Wnd
If bFolderIsOpen = FALSE Then 'open it for the first time
Call Shell("explorer.exe" & " " & """" & strPath & """", vbNormalFocus)
Else
oWinOpen.Visible = FALSE
oWinOpen.Visible = TRUE
End If

Office 2013 Excel .PutInClipboard is Different?

I've used a routine for years to put a plain text string into the clipboard that I can paste into another program such as:
targetData.SetText "This is a plain text string"
targetData.PutInClipboard
When I use this in Excel Office 2013 the data isn't in the clipboard and therefore I can't paste it. This never happened in prior versions.
Under closer inspection I've found that the string does go to the clipboard but as "System String" but not as "Text" or "Unicode Text".
BUT... about 10% of the time it acutally works as it should putting the string into the clipboard as "Text".
Any ideas??
user2140261's comment is the correct solution:
How to: Send Information to the Clipboard
(The following is just copied from the above link)
If you need to copy the contents of the active control on a form or report to the Clipboard, you only need this code:
Private Sub cmdCopy_Click()
Me!txtNotes.SetFocus
DoCmd.RunCommand acCmdCopy
End Sub
However, this the replacement you need for your old routine:
1. Create a module, name it "WinAPI" or something, put this code in it:
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
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
2. In the module where your old routine is defined, replace your old routine with this code:
Function ClipBoard_SetData(MyString As String)
Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, 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 Function
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 Function
3. Then, call it like this:
' doesn't work on Windows 8: targetData.SetText "This is a plain text string"
'doesn't work on Windows 8: targetData.PutInClipboard
ClipBoard_SetData ("This is a plain text string")
You should add "Microsoft forms 2.0 object library" to your references then you can use this feature.
you can do this by going to Excel/developer/Visual basic(or your VBE module) and in the tools/references select browse and then in your system32 folder search for "FM20.DLL" file and then by selecting this file at the end of the references list "Microsoft forms 2.0 object library" will be appeared. Activate that . Now things are as good as old times ;)

"Paste" string variable in excel VBA instead of the contents of clipboard?

I have a string variable that contains an HTML table in excel VBA. I know that when this table is stored in the clipboard and I invoke .PasteSpecial, Excel does some nifty preprocessing and fills the cells out in the current sheet the same way as they appear in the table.
However, if I simply set the .Value of a cell/range to the string variable, no such preprocessing takes place and the entire string, HTML tags and all, are dumped into the cell. I want the former result, but I cannot use the clipboard because it is being used by this application elsewhere and there is no guarantee I would not overwrite critical data. It is also being used asynchronously so I cannot simply save the current contents of the clipboard, use the clipboard, and then restore the previous contents of the clipboard.
So, is there any way to get the "pasting preprocessing" to occur when setting the value for a range with a formatted string?
I would still be curious to know the answer if anyone has it, but I decided to just go ahead and abandon the idea of storing the table in a worksheet. Instead I parse the table myself and find the values I need using the InStr function (as they are mostly adjacent key=value pairs), which is not terribly slow for my application.
I can't think of anyway to invoke Excel's preprocessor without the clipboard. For parsing, you may want to check out the Split function. Here's an example.
Sub ParseTable()
Dim sHtmlTable As String
Dim vaTable As Variant
Dim i As Long
Const STDSTART = "<td"
Const STDEND = "</td"
sHtmlTable = "<table border=""1""><tr><td>row 1, cell 1</td><td>row 1, cell 2</td></tr><tr><td>row 2, cell 1</td><td>row 2, cell 2</td></tr></table>"
vaTable = Split(sHtmlTable, ">")
For i = LBound(vaTable) To UBound(vaTable)
If vaTable(i) = STDSTART Then
Debug.Print Replace(vaTable(i + 1), STDEND, "")
End If
Next i
End Sub
This is just a comment (stackeoverflow doesn't let me comment the propper way yet).
You probably could do it the way you want using some API.
A long time ago I played with it (looking for some way to cheat MS Word) and I remember that you could store any content to the clipboard, as long as you enter the right id of the content type (like pure text, formated text, html, etc). After storing the content, you must use the respective API function to paste, again, the right type of content.
I didn't make progress as fast as I expected, and I was short of time, so I abandoned the idea. If you would like to give it a chance, look up MSDN for the API calls (I don't have it here right now, otherwise I would give you right away).
EDIT: I found the code. All the code below should be kept in a module:
' Clipboard functions:
Private Declare Function OpenClipboard Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "USER32" () As Long
Private Declare Function GetClipboardData Lib "USER32" (ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "USER32" (ByVal wFormat As Long) As Long
Private Declare Function RegisterClipboardFormat Lib "USER32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long
' Memory functions:
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 GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Public Function GetClipboardIDForCustomFormat(ByVal sName As String) As Long
Dim wFormat As Long
wFormat = RegisterClipboardFormat(sName & Chr$(0))
If (wFormat > &HC000&) Then
GetClipboardIDForCustomFormat = wFormat
End If
End Function
Public Function GetClipboardDataAsString(ByVal lFormatID As Long) As String
'Public Function GetClipboardDataAsString(ByVal hWndOwner As Long, ByVal lFormatID As Long) As String
Dim bData() As Byte
Dim hMem As Long
Dim lSize As Long
Dim lPtr As Long
' Open the clipboard for access:
If (OpenClipboard(0&)) Then
' If (OpenClipboard(hWndOwner)) Then
' Check if this data format is available:
If (IsClipboardFormatAvailable(lFormatID) <> 0) Then
' Get the memory handle to the data:
hMem = GetClipboardData(lFormatID)
If (hMem <> 0) Then
' Get the size of this memory block:
lSize = GlobalSize(hMem)
If (lSize > 0) Then
' Get a pointer to the memory:
lPtr = GlobalLock(hMem)
If (lPtr <> 0) Then
' Resize the byte array to hold the data:
ReDim bData(0 To lSize - 1) As Byte
' Copy from the pointer into the array:
CopyMemory bData(0), ByVal lPtr, lSize
' Unlock the memory block:
GlobalUnlock hMem
' Now return the data as a string:
GetClipboardDataAsString = StrConv(bData, vbUnicode)
End If
End If
End If
End If
CloseClipboard
End If
End Function

Resources