求VB代码 在当前word文档中获取该文件名到剪贴板?

2025-04-06 14:20:12
推荐回答(2个)
回答1:

Dim mydata As New DataObject
mydata.SetText Application.ActiveWindow.Document.FullName
mydata.PutInClipboard

回答2:

注意了,VB与VBA是不一样的哦

Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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
Private Const CF_TEXT = 1
Private Sub GetClipText()
Dim hMem As Long
Dim lpData As Long
Dim nClipSize As Long
Dim bytClipData() As Byte
Dim sClipString As String

If OpenClipboard(ByVal 0&) Then '如果OpenClipboard函数返回非0值,说明成功打开剪贴板
hMem = GetClipboardData(CF_TEXT) '获取剪贴板中以文本格式存在的内存对象的句柄
If CBool(hMem) Then '如果剪贴板中对应的格式不存在,此时的hMem会是0(Null),这里用CBool把它转换成Boolean类型加以判断
lpData = GlobalLock(hMem) '获取内存对象第一个字节的内存地址
nClipSize = GlobalSize(hMem) '获取内存对象的字节长度
ReDim bytClipData(1 To nClipSize) '修改缓冲字节数组的长度,确保能够容纳内存对象的全部数据
CopyMemory bytClipData(1), ByVal lpData, nClipSize '复制内存对象的数据到字节数组中,注意Byval的用法
sClipString = StrConv(bytClipData, vbUnicode) '将字节转化成字符串
MsgBox "当前剪贴板内的文本是:" & vbCrLf & sClipString '将结果显示给用户
Else
MsgBox "当前剪贴板内没有文本"
End If
CloseClipboard
End If
End Sub