VBA: чтение файла из буфера обмена

Question

Я пытаюсь загрузить файл в макрос VBA, который был скопирован, скажем, из окна проводника.

Я легко могу получить данные из буфера обмена, используя DataObject :: GetFromClipboard, но интерфейс VBA для DataObject, похоже, не имеет методов для работы с любыми другими форматами, кроме простого текста. Есть только методы GetText и SetText.

Если я не могу получить поток файлов непосредственно из DataObject, имя файла (-ов) также подойдет, поэтому, возможно, GetText можно будет принудительно вернуть имя файла, помещенного в буфер обмена?

Везде очень мало документации для VBA. (

Может быть, кто-то может указать мне на класс-оболочку API для VBA, который имеет такую ​​функциональность?

Answer 1

Это работает для меня (в модуле);

Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal uFormat As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal uFormat As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal drop_handle As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long

Private Const CF_HDROP As Long = 15

Public Function GetFiles(ByRef fileCount As Long) As String()
    Dim hDrop As Long, i As Long
    Dim aFiles() As String, sFileName As String * 1024

    fileCount = 0

    If Not CBool(IsClipboardFormatAvailable(CF_HDROP)) Then Exit Function
    If Not CBool(OpenClipboard(0&)) Then Exit Function

    hDrop = GetClipboardData(CF_HDROP)
    If Not CBool(hDrop) Then GoTo done

    fileCount = DragQueryFile(hDrop, -1, vbNullString, 0)

    ReDim aFiles(fileCount - 1)
    For i = 0 To fileCount - 1
        DragQueryFile hDrop, i, sFileName, Len(sFileName)
        aFiles(i) = Left$(sFileName, InStr(sFileName, vbNullChar) - 1)
    Next
    GetFiles = aFiles
done:
    CloseClipboard
End Function

Использование:

Sub wibble()
    Dim a() As String, fileCount As Long, i As Long
    a = GetFiles(fileCount)
    If (fileCount = 0) Then
        MsgBox "no files"
    Else
        For i = 0 To fileCount - 1
            MsgBox "found " & a(i)
        Next
    End If
End Sub

Answer 2

Похоже, странный способ попытаться добраться до текстового файла. Класс DataObject предназначен только для работы с текстовыми строками в буфер обмена и из него.

Вот очень хороший источник этого: http://www.cpearson.com/excel/Clipboard.aspx

Если вы хотите получить файловый поток файла, вы можете посмотреть в классы FileSystemObject и TextStream.

Answer 3

Сохраните файлы, если они находятся в буфере обмена, в папку назначения.

Public Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long

Public Const CF_HDROP       As Long = 15

        Public Function SaveFilesFromClipboard(DestinationFolder As String) As Boolean
            SaveFilesFromClipboard = False
            If Not CBool(IsClipboardFormatAvailable(CF_HDROP)) Then Exit Function
            CreateObject("Shell.Application").Namespace(CVar(DestinationFolder)).self.InvokeVerb "Paste"
            SaveFilesFromClipboard = True
        End Function