クリップボードへ情報を送信する方法
プロシージャ名: ClipBoard_SetData
-----------------------------------------------------------------------------
Option Compare Database
Option Explicit
'宣言部 に Win 32 API の関数を参照するための宣言をします。
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
-----------------------------------------------------------------------------
Function ClipBoard_SetData(MyString As String)
Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, X As Long

' 移動可能なグローバル メモリを割り当てます。
hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)

' ブロックをロックして、このメモリへの far ポインタを取得します。
lpGlobalMemory = GlobalLock(hGlobalMemory)

' 文字列をこのグローバル メモリへコピーします。
lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)

' メモリのロックを解除します。
If GlobalUnlock(hGlobalMemory) <> 0 Then
MsgBox "メモリのロックを解除できません。処理が失敗しました。"
GoTo OutOfHere2
End If

' データをコピーするクリップボードを開きます。
If OpenClipboard(0&) = 0 Then
MsgBox "クリップボードを開くことができません。処理が失敗しました。"
Exit Function
End If

' クリップボードの内容を消去します。
X = EmptyClipboard()

' データをクリップボードへコピーします。
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere2:
If CloseClipboard() = 0 Then
MsgBox "クリップボードを閉じることができません。"
End If

End Function