Vba实现复制文本到剪切板
复制字符串到剪切板：
Sub PutDataInClipboard()
Dim objShell As Object
Dim strInt As String
strInt = "12345"
Set objShell = CreateObject("WScript.shell")
objShell.Run "cmd /C echo|set/p=" & strInt & "| CLIP", 2
End Sub复制任意文件到剪切板：
Private Declare PtrSafe Sub Sleep Lib "KERNEL32" (ByVal dwMilliseconds As Long)
Sub test()
Dim arr
Dim name As String
Dim msg As String
Dim k As Long, j As Long
Dim n As Long
Rem 判断微信是否已打开
If 判断微信是否打开() = False Then
MsgBox "请先打开微信！"
Exit Sub
End If
Rem 选择文件夹
Dim folderPath As String
folderPath = SelectFolder()
If folderPath = "" Then Exit Sub
folderPath = folderPath & "\"
Rem 遍历文件
Dim arrFile() As String
Dim trr
trr = GetFileName(folderPath)
If Not IsArray(trr) Then
MsgBox "未找到文件！"
Exit Sub
End If
ReDim arrFile(1 To UBound(trr))
For k = 1 To UBound(trr)
arrFile(k) = trr(k)
Next
Rem 根据路径打开微信程序
' Shell "D:\SoftInstall\WeChat\WeChat.exe"
n = Range("A" & Rows.Count).End(xlUp).Row
arr = Range("A1").Resize(n, 2).Value
Rem Ctrl + Alt + W 打开微信界面
SendKeys "^%w"
For k = 1 To n
name = arr(k, 1) '微信名
msg = arr(k, 2) '信息
Rem 微信名写入剪贴板（测试发现有些微信息使用 Sendkeys 发送不成功，改用剪贴板）
Call 文本写入剪贴板(name)
Sleep 500 '延时等待
Rem 在微信中按 Ctrl + F 搜索
SendKeys "^f"
Sleep 500
SendKeys "^A"
Sleep 50
Rem Ctrl + V 粘贴微信名
SendKeys "^v"
Sleep 500
Rem 回车，打开对话框
SendKeys "{Enter}"
Sleep 500
Rem 输入信息
SendKeys msg
Sleep 500
Rem 发送信息
SendKeys "{Enter}"
Sleep 500
Rem 调用API，一次性复制多个文件
CutOrCopyFiles arrFile
Sleep 500
Rem 粘贴文件
SendKeys "^v"
Sleep 500
Rem 发送文件
SendKeys "{Enter}"
Sleep 500
Rem 调用API，逐个复制文件
' For j = 1 To UBound(arrFile)
' Rem 复制文件到剪贴板
' clipCopyFile (folderPath & arrFile(j))
' Sleep 500
'
' Rem 粘贴文件
' SendKeys "^v"
' Sleep 500
'
' Rem 发送文件
' SendKeys "{Enter}"
' Sleep 500
' Next
Next
Rem 以上代码执行结束后，NUM 键熄灭，再按一次
SendKeys "{NUMLOCK}" '按下数字锁定键
SendKeys "%{Tab}" 'Alt + Tab 返回 Excel 界面
End Sub