VBA module Clipboard

Clipboard.vb

'
'  V.2
'
option explicit

' { WinAPI declarations

declare function GlobalAlloc         lib "kernel32"                                   ( _
     byVal wFlags         as long, _
     byVal dwBytes        as long) as long

declare function lstrcpy lib "kernel32"                                               ( _
     byVal lpString1 as any, _
     byVal lpString2 as any) as long


declare function EmptyClipboard      lib "User32" () as long

declare function CloseClipboard      lib "User32" () as long
declare function OpenClipboard       lib "User32"                                     ( _
     byVal hwnd          as long                   ) as long

declare function GlobalLock          lib "kernel32"                                   ( _
     byVal hMem          as long                   ) as long

declare function GlobalUnlock        lib "kernel32"                                   ( _
     byVal hMem          as long                   ) as long

declare function SetClipboardData    lib "User32"                                     ( _
     byVal wFormat as long, _
     byVal hMem    as long                         ) as long

declare function GetClipboardData    lib "User32"                                     ( _
     byVal wFormat as long                         ) as long

private const GHND                          = &h42
private const CF_TEXT                       = 1

' }

sub textToClipboard(txt as string) ' {

   dim memory       as long
   dim lockedMemory as long

   memory       = GlobalAlloc(GHND, len(txt) + 1)
   if memory = 0 then
      msgBox "GlobalAlloc failed"
      exit sub
   end if

   lockedMemory = GlobalLock(memory)
   if lockedMemory = 0 then
      msgBox "GlobalLock failed"
      exit sub
   end if

   lockedMemory = lstrcpy(lockedMemory, txt)

   call GlobalUnlock(memory)

   if openClipboard(0) = 0 Then
      msgBox "openClipboard failed"
      exit sub
   end if

   EmptyClipboard

   call SetClipboardData(CF_TEXT, memory)

   if CloseClipboard() = 0 then
      msgBox "CloseClipboard failed"
   end if

end sub ' }

function clipboardToText() as string ' {

   dim h            as long
   dim lockedMemory as long


   if OpenClipboard(0) = 0 then
      msgBox "Could not open Clipboard"
      exit function
   end if

   h = GetClipboardData(CF_TEXT)

   if h = 0 then
      msgBox "GetClipboardData could not allocate memory"
      exit function
   end if

   lockedMemory = GlobalLock(h)
   if lockedMemory = 0 then
      msgBox "GlobalLock failed"
      exit function
   end if

   dim str as string

 ' Hopefully, 1 MB is enough...
 ' ... otherwise, the lstrcpy below will fail miserably!
   str = space$(1# * 1024 * 1024)

   lstrcpy str, lockedMemory
   GlobalUnlock(lockedMemory)

 '
 ' Remove 'text' after null-byte:
 '
   dim pos as long
   pos = inStr(1, str , Chr$(0), 0)
   str = mid(str, 1,  pos-1)

   if CloseClipboard() = 0 then
      msgBox "CloseClipboard failed"
   end if

   clipboardToText = str

end function ' }

Test

option explicit

sub main() ' {
    dim txt as string

    txt = ClipboardToText
    msgBox "Content of clipboard is" & vbNewline & vbNewline & txt

    txt = "line one" & vbNewline & "line two" & vbNewline & "line three" & vbNewline

    textToClipboard txt
    msgBox "Clipboard should contain" & vbNewline & vbNewline & txt, vbOkOnly, "Verify clipboard"

end sub ' }

<job>
<script language="VBScript" src="..\..\VBS-MS-Office-App-Creator\create-MS-Office-app.vbs" />
<script language="VBScript">

   option explicit

   dim app
   dim xls
   set xls = createOfficeApp("excel", currentDir() & "ExcelHelper.xlsm")
   if xls is nothing then ' {
      wscript.echo("Could not create excel worksheet.")
      wscript.quit(-1)
   end if ' }

   set app = xls.application

   insertModule app, currentDir() & "test.vb"                     , "func"     , 1
   insertModule app, currentDir() & "..\..\..\Common\Clipboard.vb", "clipboard", 1

   createObject("WScript.Shell").appActivate(app.caption)
   call app.run("main")

   xls.save

</script> </job>

History

See also