NOT ANSWERED: Find Function to pick up clipboard

[carl777]

I'm trying to get a recorded Word 2000 macro to pick up the contents of the clipboard, but I don't know the VBA syntax. Can I write something like .Text = GetFromClipboard within the With Selection.Find section below? I need the line .Text = "Sc" below to reflect the current and changing contents of the windows clipboard, which for my purposes will be just 2 letters of the alphabet, but not necessarily “Sc”.

Selection.Copy
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Sc"
.Wrap = wdFindContinue
.Format = True
End With

IN REGARD TO PREVIOUS RESPONSES, when I put

Dim MyData As DataObject and
Set MyData = New DataObject

at the top of the module, I get
"User-defined type not defined." erors on both of those statements when I try to run the macro.

I assume that I embed the

MyData.GetFromClipboardstrClip and the
strClip = MyData.GetText

statments right after the relevant

Selection.Copy statement

and then, finally, use

.Text = strClip

within the relevant With Selection.Find statement??

 

[JustinEzequiel]

I only have Word 97 but try this:

Option Explicit

Sub test()
  Dim obj As DataObject ' Microsoft Forms 2.0 Object Library
  
  Dim str As String
  
  Set obj = New DataObject
  obj.GetFromClipboard
  
  str = obj.GetText(1)
  
  MsgBox str
  
  Set obj = Nothing
End Sub

 

[JustinEzequiel]

should have finished reading your post before answering

anyway, here's a working example

for the following code to work, you'll need a Reference to "Microsoft Forms 2.0 Object Library" (Tools-->References)

Dim obj As msforms.DataObject

Option Explicit

Sub WhatEver()
  Selection.Copy
  
  Selection.Find.ClearFormatting
  With Selection.Find
    .Text = GetClipText
    
    .Wrap = wdFindContinue
    
    .Replacement.Text = UCase$("hello")
    
    .Execute replace:=wdReplaceAll
  End With
End Sub

Private Function GetClipText() As String
  Dim obj As msforms.DataObject
  Dim str As String
  
  Set obj = New DataObject
  obj.GetFromClipboard
  
  str = obj.GetText(1)
  
  Set obj = Nothing
  
  GetClipText = str
End Function

 

[TopJack]

Someone has beat me to it. Its very much the same, but here goes anyway.


Sub GetClipBoardText()
Dim MyData As DataObject, sClipText As String
Set MyData = New DataObject

On Error GoTo NotText ' Trap any errors

Selection.Copy

MyData.GetFromClipboard ' Get data from the clipboard.

sClipText = MyData.GetText(1) ' Assign clipboard contents to string variable.

With Selection.Find 'routine to find your text from the clipboard
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
.Execute FindText:=sClipText
End With

NotText:
If Err <> 0 Then
MsgBox &quot;Data on clipboard is not text.&quot; ' message if there is a problem
End If

End Sub

This routine assumes you have text already selected.

Hope this helps.

 

[oharab]

Carl,
These 2 functions will set and get data to and from the clipboard using pure api functions. No references required.
Copy everything to a new module and use them.

EasyPeasy!

Ben


Public Const GHND = &H42
Public Const CF_TEXT = 1
Private Const CF_ANSIONLY = &H400&
Private Const CF_APPLY = &H200&
Private Const CF_BITMAP = 2
Private Const CF_DIB = 8
Private Const CF_DIF = 5
Private Const CF_DSPBITMAP = &H82
Private Const CF_DSPENHMETAFILE = &H8E
Private Const CF_DSPMETAFILEPICT = &H83
Private Const CF_DSPTEXT = &H81
Private Const CF_EFFECTS = &H100&
Private Const CF_ENABLEHOOK = &H8&
Private Const CF_ENABLETEMPLATE = &H10&
Private Const CF_ENABLETEMPLATEHANDLE = &H20&
Private Const CF_ENHMETAFILE = 14
Private Const CF_FIXEDPITCHONLY = &H4000&
Private Const CF_FORCEFONTEXIST = &H10000
Private Const CF_GDIOBJFIRST = &H300
Private Const CF_GDIOBJLAST = &H3FF
Private Const CF_HDROP = 15
Private Const CF_INITTOLOGFONTSTRUCT = &H40&
Private Const CF_LIMITSIZE = &H2000&
Private Const CF_LOCALE = 16
Private Const CF_MAX = 17
Private Const CF_METAFILEPICT = 3
Private Const CF_NOFACESEL = &H80000
Private Const CF_NOSCRIPTSEL = &H800000
Private Const CF_NOSIMULATIONS = &H1000&
Private Const CF_NOSIZESEL = &H200000
Private Const CF_NOSTYLESEL = &H100000
Private Const CF_NOVECTORFONTS = &H800&
Private Const CF_NOOEMFONTS = CF_NOVECTORFONTS
Private Const CF_NOVERTFONTS = &H1000000
Private Const CF_OEMTEXT = 7
Private Const CF_OWNERDISPLAY = &H80
Private Const CF_PALETTE = 9
Private Const CF_PENDATA = 10
Private Const CF_PRINTERFONTS = &H2
Private Const CF_PRIVATEFIRST = &H200
Private Const CF_PRIVATELAST = &H2FF
Private Const CF_RIFF = 11
Private Const CF_SCALABLEONLY = &H20000
Private Const CF_SCREENFONTS = &H1
Private Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
Private Const CF_SCRIPTSONLY = CF_ANSIONLY
Private Const CF_SELECTSCRIPT = &H400000
Private Const CF_SHOWHELP = &H4&
Private Const CF_SYLK = 4
Private Const CF_TIFF = 6
Private Const CF_TTONLY = &H40000
Private Const CF_UNICODETEXT = 13
Private Const CF_USESTYLE = &H80&
Private Const CF_WAVE = 12
Private Const CF_WYSIWYG = &H8000

Private Declare Function GlobalAlloc Lib &quot;kernel32&quot; (ByVal wFlags&, ByVal _
dwBytes As Long) As Long
Private Declare Function GlobalLock Lib &quot;kernel32&quot; (ByVal hMem As Long) _
As Long
Private Declare Function GlobalSize Lib &quot;kernel32&quot; (ByVal hMem As Long) _
As Long
Private Declare Function lstrcpy Lib &quot;kernel32&quot; (ByVal lpString1 As Any, _
ByVal lpString2 As Any) As Long
Private Declare Function lstrlen Lib &quot;kernel32&quot; Alias &quot;lstrlenA&quot; _
(ByVal lpString As String) As Long

Private Declare Function GlobalUnlock Lib &quot;kernel32&quot; (ByVal hMem As Long) _
As Long

Private Declare Function OpenClipboard Lib &quot;user32&quot; (ByVal hWnd As Long) _
As Long
Private Declare Function CloseClipboard Lib &quot;user32&quot; () As Long
Private Declare Function GetClipboardData Lib &quot;user32&quot; (ByVal wFormat As _
Long) As Long
Private Declare Function EmptyClipboard Lib &quot;user32&quot; () As Long
Private Declare Function SetClipboardData Lib &quot;user32&quot; (ByVal wFormat _
As Long, ByVal hMem As Long) As Long

Function ClipBoard_SetText(strCopyString As String) As Boolean
Dim hGlobalMemory As Long
Dim lpGlobalMemory As Long
Dim hClipMemory As Long

' Allocate moveable global memory.
'-------------------------------------------
hGlobalMemory = GlobalAlloc(GHND, Len(strCopyString) + 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, strCopyString)

' Unlock the memory and then copy to the clipboard
If GlobalUnlock(hGlobalMemory) = 0 Then
If OpenClipboard(0&) <> 0 Then
Call EmptyClipboard
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
ClipBoard_SetText = CBool(CloseClipboard)
End If
End If
End Function

Function ClipBoard_GetText() As String
Dim hClipMemory As Long
Dim lpClipMemory As Long
Dim strCBText As String
Dim RetVal As Long
Dim lngSize As Long
If OpenClipboard(0&) <> 0 Then
' Obtain the handle to the global memory
' block that is referencing the text.
hClipMemory = GetClipboardData(CF_TEXT)
If hClipMemory <> 0 Then
' Lock Clipboard memory so we can reference
' the actual data string.
lpClipMemory = GlobalLock(hClipMemory)
If lpClipMemory <> 0 Then
lngSize = GlobalSize(lpClipMemory)
strCBText = Space$(lngSize)
RetVal = lstrcpy(strCBText, lpClipMemory)
RetVal = GlobalUnlock(hClipMemory)
' Peel off the null terminating character.
strCBText = Left(strCBText, InStr(1, strCBText, Chr$(0), 0) - 1)
Else
MsgBox &quot;Could not lock memory to copy string from.&quot;
End If
End If
Call CloseClipboard
End If
ClipBoard_GetText = strCBText
End Function


----------------------------------------
Ben O'Hara

http://www.RobotParade.co.uk

----------------------------------------