● クリップボードのファイルリストを取得する ●

自作テキストエディタなどに組み込むと大変便利!! ホントに!!

では早速、行ってみよう。標準モジュールに書いてね。

Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long

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

Private Declare Function CloseClipboard Lib "user32" () As Long

Private Const CF_HDROP As Long = 15

Private Declare Function GetClipboardData Lib "User32.dll" (ByVal wFormat As Long) As Long

Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal HDROP As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long

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

Public Const MAX_PATH As Long = 260

Private Declare Function GlobalAlloc Lib "Kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long

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

'---------------------------------------------------------------------------
'  関数名: IsFileDropData
'  機  能: クリップボードのデータがファイルドロップ形式か判定する
'  引  数: hWnd … ウインドウハンドル
'  返り値: True:ファイルドロップ形式   False:そうではない
'  備  考: 特になし
'---------------------------------------------------------------------------
Public Function IsFileDropData(ByVal hWnd As Long) As Boolean

    Dim FuncRet As Long
    Dim ClipboardFormat As Long
    Dim IsReturnVal As Boolean

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

    Do
        'クリップボードに格納されているデータの形式を取得する
        ClipboardFormat = EnumClipboardFormats(ClipboardFormat)
        If ClipboardFormat = CF_HDROP Then
            IsReturnVal = True
            Exit Do
        End If
    Loop While (ClipboardFormat)

    'クリップボードを閉じる
    Call CloseClipboard

    IsFileDropData = IsReturnVal
End Function

'---------------------------------------------------------------------------
'  関数名: GetFileDropData
'  機  能: ファイルドロップ形式データを取得する
'  引  数: hWnd   … メインウインドウのハンドル
'           CBDataNum  … ファイルドロップ形式データ数
'           FileList … ファイルドロップ形式データ
'  返り値: 正常:True  エラー:False
'  備  考: 一気に表示する
'---------------------------------------------------------------------------
Public Function GetFileDropData(ByVal hWnd As Long, ByRef CBDataNum As Long, _
                                ByRef FileList() As String) As Boolean

    Dim i As Integer
    Dim RetClipBoardOpen As Long 'OpenClipboard() 関数返り値
    Dim FuncRet As Long          '関数返り値
    Dim hCBData As Long          'クリップボードデータハンドル
    Dim hMemDrop As Long         'クリップボードデータハンドルのポインタ
    Dim FDFileName As String * MAX_PATH  'ファイルリストのファイル名
    Dim GetCBFListNum As Long    'クリップボードのファイルリスト数
    
    'クリップボードを開く
    RetClipBoardOpen = OpenClipboard(hWnd)
    If RetClipBoardOpen = 0 Then GoTo FunctionExit

    'クリップボードデータ取得
    hCBData = GetClipboardData(CF_HDROP)
    If hCBData = 0 Then GoTo FunctionExit

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

    'クリップボードに格納されたファイル数を取得する
    GetCBFListNum = DragQueryFile(hMemDrop, -1, vbNullString, 0)

    'ファイルリスト数を格納
    CBDataNum = GetCBFListNum

    'メモリー再確保
    ReDim FileList(GetCBFListNum - 1) As String

    For i = 0 To GetCBFListNum - 1
        'FDFileName = String(MAX_PATH, Chr$(0))
        'ファイルリストよりファイル名を取得
        FuncRet = DragQueryFile(hMemDrop, i, FDFileName, MAX_PATH)
        FileList(i) = strNullCut(FDFileName)
    Next i

    'エラーが無ければここを通る
    GetFileDropData = True

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

    'メモリーオブジェクトのロックを開放する
    If hCBData Then Call GlobalUnlock(hCBData)
End Function


'---------------------------------------------------------------------------
'  関数名: strNullCut
'   機能 : 文字列を vbNullChar までを取得する
'   引数 : (in) srcStr … 対象文字列
'  返り値 :編集された文字列
'---------------------------------------------------------------------------
Public Function strNullCut(ByVal srcStr As String) As String

    Dim NullCharPos As Integer

    NullCharPos = InStr(srcStr, Chr$(0))

    If NullCharPos = 0 Then
        strNullCut = srcStr
        Exit Function
    End If

    strNullCut = Left$(srcStr, NullCharPos - 1)

End Function

一応、呼び出し側のサンプルもつけておく。エクスプローラで適当なファイルをコピーした後に実行すると、イミディエイトウインドウにコピーしたファイルのフルパスが表示される。

Private Sub Command1_Click()
    Dim FuncRetBool As Boolean
    Dim GetFileListNum As Long 'ファイルリスト数
    Dim FileList() As String   'クリップボードファイルリスト、ファイル名配列
    Dim i As Long

    'クリップボードのファイルリスト判定
    FuncRetBool = IsFileDropData(Me.hWnd)
    If FuncRetBool = False Then Beep: Exit Sub

    'クリップボードよりファイルリストを取得する
    FuncRetBool = GetFileDropData(Me.hWnd, GetFileListNum, FileList)
    If FuncRetBool = False Then Beep: Exit Sub

    'ファイルリストを表示
    For i = 0 To GetFileListNum - 1
        'ファイルリストファイル名を取得
        Debug.Print FileList(i)
    Next i
End Sub

戻る