Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

VBA PutInClipboard Error

Status
Not open for further replies.

missedthepit

Technical User
Jun 19, 2007
3
GB
I have a macro that used to run fine, then when I went to use it today it just stopped working! Basically it takes a string off the clipboard, performs a number of string replaces on it and replaces it to the clipboard. I have included the reference to Microsoft Forms 2.0 object library.

Here is a cut down version of my Code:

Dim MyData As DataObject
Dim strClip As String

...
Sub myFunc()
Set MyData = New DataObject
MyData.GetFromClipboard
strClip = MyData.GetText
strClip = Replace(strClip, "/", "-")
strClip = Replace(strClip, "GENERAL", "GEN")
strClip = Replace(strClip, "LEADCHROME", "LC")
strClip = Replace(strClip, "AERO", "AE")
strClip = Replace(strClip, "LEADED", "LD")
strClip = Replace(strClip, "UNLEADED", "UL")
strClip = Replace(strClip, "SPECIAL", "SE")
strClip = Replace(strClip, "CLEARS", "CL")
strClip = Replace(strClip, "CLEAR", "CL")
strClip = Replace(strClip, "PASTEL", "PA")
strClip = Replace(strClip, "TINT", "T")
strClip = Replace(strClip, "ROSIN", "RO")
MyData.SetText strClip
MyData.PutInClipboard

End Sub

This used to work, but now it produces the following error:
"Run-time error '-2147221036 (800401d4)'
DataObject:putInClipboard CloseClipboard Failed"

I have tested and the strClip is definitely being placed back into MyData.
Thanks in advance
 
Try
Code:
Sub myFunc()
   Set MyData = New DataObject
   MyData.GetFromClipboard
   
   On Error GoTo ERRHANDLER
   
   strclip = MyData.GetText
   strclip = Replace(strclip, "/", "-")
   strclip = Replace(strclip, "GENERAL", "GEN")
   strclip = Replace(strclip, "LEADCHROME", "LC")
   strclip = Replace(strclip, "AERO", "AE")
   strclip = Replace(strclip, "LEADED", "LD")
   strclip = Replace(strclip, "UNLEADED", "UL")
   strclip = Replace(strclip, "SPECIAL", "SE")
   strclip = Replace(strclip, "CLEARS", "CL")
   strclip = Replace(strclip, "CLEAR", "CL")
   strclip = Replace(strclip, "PASTEL", "PA")
   strclip = Replace(strclip, "TINT", "T")
   strclip = Replace(strclip, "ROSIN", "RO")
   
   MyData.SetText strclip
   MyData.PutInClipboard
   
   MsgBox MyData.GetText
   
   Exit Sub
ERRHANDLER:
   MsgBox "Empty Clipboard"
End Sub
 
Ah so I need top empty the clipboard first? I'm new to all this so I didn't realise that :)
 
Better yet, play with this
Code:
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long

Sub Clear_Clipboard()
   OpenClipboard (0)
   EmptyClipboard
   CloseClipboard
End Sub

Sub myFunc()
   Set MyData = New DataObject
   MyData.GetFromClipboard
   
   On Error GoTo ERRHANDLER
   
   strclip = MyData.GetText[COLOR=red](1)[/color]
   strclip = Replace(strclip, "/", "-")
   strclip = Replace(strclip, "GENERAL", "GEN")
   strclip = Replace(strclip, "LEADCHROME", "LC")
   strclip = Replace(strclip, "AERO", "AE")
   strclip = Replace(strclip, "LEADED", "LD")
   strclip = Replace(strclip, "UNLEADED", "UL")
   strclip = Replace(strclip, "SPECIAL", "SE")
   strclip = Replace(strclip, "CLEARS", "CL")
   strclip = Replace(strclip, "CLEAR", "CL")
   strclip = Replace(strclip, "PASTEL", "PA")
   strclip = Replace(strclip, "TINT", "T")
   strclip = Replace(strclip, "ROSIN", "RO")
   
   MyData.SetText strclip
   MyData.PutInClipboard
   
   MsgBox MyData.GetText
   
   Exit Sub
ERRHANDLER:
   MsgBox "Empty Clipboard"
End Sub
 
Okidokes, thankyou all very much for your help, I'll give it a play and see what I can do :)
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top