クリップボードからテキストデータを取得

クリップボードからテキストデータを取得する。

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