VBA:从剪贴板中读取文件

时间:2010-05-26 13:29:22

标签: file vba clipboard

我正在尝试在已经从资源管理器窗口复制的VBA宏中加载文件。

我可以使用DataObject :: GetFromClipboard轻松地从剪贴板获取数据,但是DataObject的VBA接口似乎没有处理除纯文本之外的任何其他格式的方法。只有GetText和SetText方法。

如果我无法直接从DataObject获取文件流,文件名也会这样做,那么可能会强制GetText返回放在剪贴板上的文件名?

在任何地方都可以找到很少的VBA文档。 :(

也许有人可以指向具有此类功能的VBA API包装器类?

3 个答案:

答案 0 :(得分:7)

这对我有用(在模块中);

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

答案 1 :(得分:2)

似乎是一种尝试获取文本文件的奇怪方法。 DataObject类仅用于处理来自剪贴板的文本字符串。

这是一个非常好的资源: http://www.cpearson.com/excel/Clipboard.aspx

如果您想获取文件的文件流,可以查看FileSystemObject和TextStream类。

答案 2 :(得分:1)

将文件放在剪贴板中保存到目标文件夹。

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