Home > 即効テクニック > AccessVBA > Windows環境・オブジェクト > クリップボードからテキストを取り出す

即効テクニック

Windows環境・オブジェクト

クリップボードからテキストを取り出す

(Access 97)
クリップボードから情報を取り出すには、Windows APIの関数を呼び出すVBA関数を定義する必要があります。このサンプルではクリップボードからテキストを取り出す関数を定義します。

●サンプル●
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 GlobalAlloc Lib "kernel32" _
                 (ByVal wFlags&, _
                  ByVal dwBytes 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 GlobalSize Lib "kernel32" _
                 (ByVal hMem As Long) As Long
Declare Function lstrcpy Lib "kernel32" _
                 (ByVal lpString1 As Any, _
                  ByVal lpString2 As Any) As Long

Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096

Function ClipBoard_GetData()
    Dim hClipMemory As Long
    Dim lpClipMemory As Long
    Dim MyString As String
    Dim RetVal As Long
    
    If OpenClipboard(0&) = 0 Then
        MsgBox "クリップボードが開きません"
        Exit Function
    End If
    
    ' テキストを参照しているグローバル メモリ
    ' のブロックへのハンドルを取得します。
    hClipMemory = GetClipboardData(CF_TEXT)
    If IsNull(hClipMemory) Then
        MsgBox "Could not allocate memory"
        GoTo OutOfHere
    End If
    
    ' クリップボードのメモリをロックし、実際の
    ' データ文字列を参照します。
    lpClipMemory = GlobalLock(hClipMemory)
    
    If Not IsNull(lpClipMemory) Then
        MyString = Space$(MAXSIZE)
        RetVal = lstrcpy(MyString, lpClipMemory)
        RetVal = GlobalUnlock(hClipMemory)
        
        ' null 終了文字を削除します。
        MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
    Else
        MsgBox "Could not lock memory to copy string from."
    End If
    
OutOfHere:

    RetVal = CloseClipboard()
    ClipBoard_GetData = MyString

End Function