EXCEL VBA"调用"微信发送文件
ztj100 2024-12-16 17:39 46 浏览 0 评论
思路与之前发送信息一样,将“文件”放入剪贴板中,就可以用CTRL+V,粘贴到微信信息框中实现发送文件了。
可是VBA 自带函数FileCopy 并不产生文件复制到剪贴板的效果,需调用Window API接口操作,代码如下。(来自EXCEL HOME论坛)
Private Declare PtrSafe Function RegisterClipboardFormat Lib "user32.dll" Alias "RegisterClipboardFormatW" (ByVal lpString As LongPtr) As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal flags As Long, ByVal Size As Long) As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal hpvDest As LongPtr, ByVal hpvSource As LongPtr, ByVal cbCopy As Long)
' API函数定义结束
Private Const CF_HDROP As Long = 15&
Private Const DROPEFFECT_COPY As Long = 1
Private Const DROPEFFECT_MOVE As Long = 2
Private Const GMEM_ZEROINIT As Long = &H40
Private Const GMEM_MOVEABLE As Long = &H2
Private Const GMEM_DDESHARE As Long = &H2000
' 结构定义开始
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type dropFiles
pFiles As Long
pt As POINTAPI
fNC As Long
fWide As Long
End Type
' 结构定义结束
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
上面的代码都是 API函数的定义所需的(64位的VBE环境)。下面代码是将文件复制到剪贴板。
Sub clipCopyFile(FileList As Variant)
Dim uDropEffect As Long, I As Long
Dim dropFiles As dropFiles
Dim uGblLen As Long, uDropFilesLen As Long
Dim hGblFiles As LongPtr
Dim hGblEffect As LongPtr
Dim mPtr As LongPtr
Dim FName As String
If OpenClipboard(0) Then
EmptyClipboard
FName = Trim(FileList)
If Len(FName) Then
uDropEffect = RegisterClipboardFormat(StrPtr("Preferred DropEffect"))
hGblEffect = GlobalAlloc(GMEM_ZEROINIT Or GMEM_MOVEABLE Or GMEM_DDESHARE, Len(uDropEffect))
mPtr = GlobalLock(hGblEffect)
I = DROPEFFECT_COPY
CopyMemory mPtr, VarPtr(I), Len(I)
GlobalUnlock hGblEffect
SetClipboardData uDropEffect, hGblEffect
uDropFilesLen = LenB(dropFiles)
With dropFiles
.pFiles = uDropFilesLen
.fWide = CLng(True)
End With
uGblLen = uDropFilesLen + LenB(FName) + 8
hGblFiles = GlobalAlloc(GMEM_ZEROINIT Or GMEM_MOVEABLE Or GMEM_DDESHARE, uGblLen)
mPtr = GlobalLock(hGblFiles)
CopyMemory mPtr, VarPtr(dropFiles), uDropFilesLen
mPtr = mPtr + uDropFilesLen
hGblEffect = StrPtr(FName)
I = LenB(FName)
CopyMemory mPtr, hGblEffect, I
GlobalUnlock hGblFiles
SetClipboardData CF_HDROP, hGblFiles
End If
CloseClipboard
End If
End Sub
此clipCopyFile过程只处理单个的文件(已被我修改了),需要一次处理多个文件的,可去EXCEL HOME论坛查看源码。
微信发文件代码:
Sub 发文件()
Set ws = CreateObject("wscript.shell")
ws.SendKeys "^%w"
For I = 2 To Cells(Rows.Count, 1).End(xlUp).Row
ws.Run "mshta vbscript:ClipboardData.SetData(""Text""," & Chr(34) & Cells(I, 1) & Chr(34) & ")(close)", 0, True
Sleep 300
ws.SendKeys "^f"
Sleep 1000
ws.SendKeys "^v"
Sleep 500
ws.SendKeys "{ENTER}"
Sleep 500
ws.Run "mshta vbscript:ClipboardData.SetData(" & Chr(34) & "Text" & Chr(34) & "," & Chr(34) & Cells(I, 2) & Chr(34) & ")(close)", 0, True
Sleep 500
ws.SendKeys "^v"
Sleep 500
ws.SendKeys "{ENTER}"
wjName = Cells(I, 3).Value
clipCopyFile wjName
ws.SendKeys "^v"
Sleep 500
ws.SendKeys "{ENTER}"
Next I
Set ws = Nothing
End Sub
相关推荐
- Sublime Text 4 稳定版 Build 4113 发布
-
IT之家7月18日消息知名编辑器SublimeText4近日发布了Build4113版本,是SublimeText4的第二个稳定版。IT之家了解到,SublimeTe...
- 【小白课程】openKylin便签贴的设计与实现
-
openKylin便签贴作为侧边栏的一个小插件,提供便捷的文本记录和灵活的页面展示。openKylin便签贴分为两个部分:便签列表...
- 壹啦罐罐 Android 手机里的 Xposed 都装了啥
-
这是少数派推出的系列专题,叫做「我的手机里都装了啥」。这个系列将邀请到不同的玩家,从他们各自的角度介绍手机中最爱的或是日常使用最频繁的App。文章将以「每周一篇」的频率更新,内容范围会包括iOS、...
- 电气自动化专业词汇中英文对照表(电气自动化专业英语单词)
-
专业词汇中英文对照表...
- Python界面设计Tkinter模块的核心组件
-
我们使用一个模块,我们要熟悉这个模块的主要元件。如我们设计一个窗口,我们可以用Tk()来完成创建;一些交互元素,按钮、标签、编辑框用到控件;怎么去布局你的界面,我们可以用到pack()、grid()...
- 以色列发现“死海古卷”新残片(死海古卷是真的吗)
-
编译|陈家琦据艺术新闻网(artnews.com)报道,3月16日,以色列考古学家发现了死海古卷(DeadSeaScrolls)新残片。新出土的羊皮纸残片中包括以希腊文书写的《十二先知书》段落,这...
- 鸿蒙Next仓颉语言开发实战教程:订单列表
-
大家上午好,最近不断有友友反馈仓颉语言和ArkTs很像,所以要注意不要混淆。今天要分享的是仓颉语言开发商城应用的订单列表页。首先来分析一下这个页面,它分为三大部分,分别是导航栏、订单类型和订单列表部分...
- 哪些模块可以用在 Xposed for Lollipop 上?Xposed 模块兼容性解答
-
虽然已经有了XposedforLollipop的安装教程,但由于其还处在alpha阶段,一些Xposed模块能不能依赖其正常工作还未可知。为了解决大家对于模块兼容性的疑惑,笔者尽可能多...
- 利用 Fluid 自制 Mac 版 Overcast 应用
-
我喜爱收听播客,健身、上/下班途中,工作中,甚至是忙着做家务时。大多数情况下我会用MarcoArment开发的Overcast(Freemium)在iPhone上收听,这是我目前最喜爱的Po...
- 浅色Al云食堂APP代码(三)(手机云食堂)
-
以下是进一步优化完善后的浅色AI云食堂APP完整代码,新增了数据可视化、用户反馈、智能推荐等功能,并优化了代码结构和性能。项目结构...
- 实战PyQt5: 121-使用QImage实现一个看图应用
-
QImage简介QImage类提供了独立于硬件的图像表示形式,该图像表示形式可以直接访问像素数据,并且可以用作绘制设备。QImage是QPaintDevice子类,因此可以使用QPainter直接在图...
- 滚动条隐藏及美化(滚动条隐藏但是可以滚动)
-
1、滚动条隐藏背景/场景:在移动端,滑动的时候,会显示默认滚动条,如图1://隐藏代码:/*隐藏滚轮*/.ul-scrool-box::-webkit-scrollbar,.ul-scrool...
- 浅色AI云食堂APP完整代码(二)(ai 食堂)
-
以下是整合后的浅色AI云食堂APP完整代码,包含后端核心功能、前端界面以及优化增强功能。项目采用Django框架开发,支持库存管理、订单处理、财务管理等核心功能,并包含库存预警、数据导出、权限管理等增...
你 发表评论:
欢迎- 一周热门
- 最近发表
- 标签列表
-
- idea eval reset (50)
- vue dispatch (70)
- update canceled (42)
- order by asc (53)
- spring gateway (67)
- 简单代码编程 贪吃蛇 (40)
- transforms.resize (33)
- redisson trylock (35)
- 卸载node (35)
- np.reshape (33)
- torch.arange (34)
- npm 源 (35)
- vue3 deep (35)
- win10 ssh (35)
- vue foreach (34)
- idea设置编码为utf8 (35)
- vue 数组添加元素 (34)
- std find (34)
- tablefield注解用途 (35)
- python str转json (34)
- java websocket客户端 (34)
- tensor.view (34)
- java jackson (34)
- vmware17pro最新密钥 (34)
- mysql单表最大数据量 (35)