クリップボードからテキストデータを取得する。
VBAでクリップボードからデータを取得するにはAPIを利用して取得します。
サンプルコードでは、クリップボードにテキストデータ以外の画像やファイルがある場合はエラーとし、テキストデータ(文字列)のみを取得できるようにしています。
#If VBA7 And Win64 Then
Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
#Else
Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function GetClipboardData Lib "user32" (ByVal wFormat 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 lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
#End If
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
'*******************************************************************
' クリップボードのテキストデータを取得
'*******************************************************************
Sub Clipboard_GetTextData()
Debug.Print getClipBoard
End Sub
'*******************************************************************
' クリップボードのデータを取得(テキストデータのみ)
'-------------------------------------------------------------------
' 戻り値 :クリップボードから取得したテキストデータ
'*******************************************************************
Function getClipBoard() As Variant
Dim lCBHndl As Long
Dim lMemPtr As Long
Dim sString As String
Dim lRetVal As Long
'クリップボードを開く
If OpenClipboard(0&) = 0 Then
getClipBoard = "(Error)クリップボードが開けません。" & _
"他アプリ等が利用している可能性があります。"
Exit Function
End If
'クリップボードオブジェクトのハンドルを取得
lCBHndl = GetClipboardData(CF_TEXT)
'
If Not IsNull(lCBHndl) Then
'テキストデータ以外は0
If lCBHndl = 0 Then
sString = "(Error)クリップボードにデータがない、" & _
"もしくはテキストデータではありませんでした。"
Else
'グローバルメモリオブジェクトのロックとメモリブロックのポインタ取得
lMemPtr = GlobalLock(lCBHndl)
If Not IsNull(lMemPtr) Then
sString = Space(MAXSIZE)
lRetVal = lstrcpy(sString, lMemPtr)
'アンロック、グローバルメモリオブジェクトのロックカウントを減らす
lRetVal = GlobalUnlock(lCBHndl)
'Nullの削除
sString = Mid(sString, 1, InStr(1, sString, Chr(0), 0) - 1)
Else
sString = "(Error)ロックができませんでした。"
End If
End If
Else
sString = "(Error)クリップボードにデータがありません。"
End If
'クリップボードを閉じる
lRetVal = CloseClipboard()
'実行結果
getClipBoard = sString
End Function


