● クリップボードの文字列を取得する ●

APIだと色々と大変。素直にClipBoardオブジェクトを使った方がいい。

lstrlen、CopyMemory のあたりがちょっと苦しく、VBっぽくない。

Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long

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 GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long

Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long

Private Const CF_TEXT = 1

Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

'----------------------------------------------------------------------
' 関数名  :GetClipboardText
' 機能    :クリップボードより文字列を取得する
' 引数    :(i)hWnd … 呼び出したウインドウのハンドル
'           (i)ClipboardText … クリップボードより取得した文字列
' 返り値  :正常終了:True  異常終了:False
'----------------------------------------------------------------------
Public Function GetClipboardText(ByVal hWnd As Long, ByRef ClipboardText As String) As Boolean
    Dim FuncRetLong As Long
    Dim RetClipBoardOpen As Long 'OpenClipboard() 関数返り値
    Dim hCBData As Long          'クリップボードデータハンドル
    Dim hMemText As Long         'クリップボードデータハンドルのポインタ
    Dim GetTextLen As Long       '取得した文字列サイズ(Shift-Jis)
    Dim GetTextByte() As Byte    '取得した文字列

    'クリップボードのデータがテキスト型か判定する
    FuncRetLong = IsClipboardFormatAvailable(CF_TEXT)
    If FuncRetLong = 0 Then Exit Function

    'クリップボードを開く
    RetClipBoardOpen = OpenClipboard(hWnd)
    If FuncRetLong = 0 Then Exit Function

    'クリップボードの文字列データを取得する
    hCBData = GetClipboardData(CF_TEXT)

    'メモリーオブジェクトをロックする
    hMemText = GlobalLock(hCBData)
    If hMemText = 0 Then GoTo FunctionExit

    '取得した文字列のサイズを取得する
    GetTextLen = lstrlen(hMemText)
    If GetTextLen = 0 Then GoTo FunctionExit

    'メモリ領域を確保し、バイト配列にコピー
    ReDim GetTextByte(GetTextLen - 1) As Byte
    Call CopyMemory(GetTextByte(0), ByVal hMemText, GetTextLen)

    'データ取得
    ClipboardText = StrConv(GetTextByte, vbUnicode)

    '処理正常
    GetClipboardText = True

FunctionExit:
    'グローバルメモリのロックを解除する
    If hCBData Then Call GlobalUnlock(hCBData)

    'クリップボードを閉じる
    If RetClipBoardOpen Then Call CloseClipboard
End Function

戻る