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 |