共计 3975 个字符,预计需要花费 10 分钟才能阅读完成。
在传统行业,用 Excel 做表比通过 Python 操作更加广泛,Excel 也能够通过 VBA 实现报表自动化:自动更新数据,用公式 / 代码生成点评,通过 Outlook 主动群发邮件,嵌入代码的 xlsm 能够间接发送给其他人应用,无需打包成 exe… 于是企微机器人传值这种 Python 几行代码的事件也只能捏着鼻子上那么一百几十行 VBA 了。
本文代码解决流程中 3 个次要步骤:
- 将 Excel 工作表的指定区域保留为图片
- 获取保留的图片的 MD5 和 Base64
- 将 MD5 和 Base64 组成 json 格局发送企微提供的 Webhook
(一)保留图片示例代码
保留的图片有可能为空白,能够减少文件大小校验。
Public Function RangeToPic(Rng As Range) | |
' 应用以后文件所在门路作为输入门路 | |
Pth = ActiveWorkbook.Path | |
' 应用【文件名_区域地址】作为输入文件名 | |
Pnm = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1) & "_" & Replace(Rng.Address(0, 0), ":", "_") | |
' 把抉择范畴内容转化为截屏图片信息 | |
Rng.CopyPicture Appearance:=xlScreen, Format:=xlBitmap | |
With ActiveSheet.ChartObjects.Add(0, 0, Rng.Width + 1, Rng.Height + 1).Chart | |
.ChartArea.Border.LineStyle = 0 | |
.Parent.Select | |
.Paste | |
.Export Pth & "\" & Pnm & ".png", "PNG" | |
.Parent.Delete | |
End With | |
End Function |
(二)用 VBA 获取文件 MD5
倡议封装为模块,调用 MD5File(文件门路)
Option Explicit | |
Type MD5_CTX | |
dwNUMa As Long | |
dwNUMb As Long | |
Buffer(15) As Byte | |
cIN(63) As Byte | |
cDig(15) As Byte | |
End Type | |
Private Declare PtrSafe Sub MD5Init Lib "advapi32" (lpContext As MD5_CTX) | |
Private Declare PtrSafe Sub MD5Final Lib "advapi32" (lpContext As MD5_CTX) | |
Private Declare PtrSafe Sub MD5Update Lib "advapi32" (lpContext As MD5_CTX, ByRef lpBuffer As Any, ByVal BufSize As Long) | |
Private stcContext As MD5_CTX | |
' 计算一个字符串(ANSI 编码)的 MD5 码:输出字符串文本,返回 MD5 码(16 字节的 Byte 数组)Public Function MD5String(strText As String) As Byte() | |
Dim aBuffer() As Byte | |
Call MD5Init(stcContext) | |
If (Len(strText) > 0) Then | |
aBuffer = StrConv(strText, vbFromUnicode) | |
Call MD5Update(stcContext, aBuffer(0), UBound(aBuffer) + 1) | |
Else | |
Call MD5Update(stcContext, 0, 0) | |
End If | |
Call MD5Final(stcContext) | |
MD5String = stcContext.cDig | |
End Function | |
' 计算一个字节流的 MD5 码:输出 Byte 数组和长度(可选,默认计算整个长度),返回 MD5 码(16 字节的 Byte 数组)Public Function MD5Bytes(Buffer() As Byte, _ | |
Optional ByVal size As Long = -1) As Byte() | |
Dim U As Long, pBase As Long | |
pBase = LBound(Buffer) | |
U = UBound(Buffer) - pBase | |
If (-1 = size) Then size = U + 1 | |
Call MD5Init(stcContext) | |
If (-1 = U) Then | |
Call MD5Update(stcContext, 0, 0) | |
Else | |
Call MD5Update(stcContext, Buffer(pBase), size) | |
End If | |
Call MD5Final(stcContext) | |
MD5Bytes = stcContext.cDig | |
End Function | |
' 计算一个文件的 MD5 码:输出磁盘文件名(残缺门路),返回 MD5 码(16 字节的 Byte 数组)Public Function MD5File(ByVal FileName As String) As Byte() | |
Const BUFFERSIZE As Long = 1024& * 512 ' 缓冲区 512KB | |
Dim DataBuff() As Byte | |
Dim lFileSize As Long | |
Dim iFn As Long | |
On Error GoTo E_Handle_MD5 | |
If (Len(Dir$(FileName)) = 0) Then Err.Raise 5 ' 文件不存在 | |
ReDim DataBuff(BUFFERSIZE - 1) | |
iFn = FreeFile() | |
Open FileName For Binary As #iFn | |
lFileSize = LOF(iFn) | |
Call MD5Init(stcContext) | |
If (lFileSize = 0) Then | |
Call MD5Update(stcContext, 0, 0) | |
Else | |
Do While (lFileSize > 0) | |
Get iFn, , DataBuff | |
If (lFileSize > BUFFERSIZE) Then | |
Call MD5Update(stcContext, DataBuff(0), BUFFERSIZE) | |
Else | |
Call MD5Update(stcContext, DataBuff(0), lFileSize) | |
End If | |
lFileSize = lFileSize - BUFFERSIZE | |
Loop | |
End If | |
Close iFn | |
Call MD5Final(stcContext) | |
E_Handle_MD5: | |
MD5File = stcContext.cDig | |
End Function |
(三)用 VBA 获取图片 Base64
调用 EncodeFilebase64(文件门路)
Public Function EncodeFilebase64(strPicPath As String) As String | |
Dim PicExtn As String, FLPath As String | |
Dim StrPath As Variant | |
Dim BSC As Long | |
Dim fso As Object | |
PicExtn = Split(strPicPath, ".")(1) | |
' 返回没有换行符的 base64 值 | |
FLPath = Replace(strPicPath, PicExtn, ".txt") | |
EncodeFilebase64 = Replace(EncodeFile(strPicPath), Chr(10), "") | |
End Function | |
Public Function EncodeFile(strPicPath As String) As String | |
Const adTypeBinary = 1 | |
Dim objXML | |
Dim objDocElem | |
Dim objStream | |
Set objStream = CreateObject("ADODB.Stream") | |
objStream.Type = adTypeBinary | |
objStream.Open | |
objStream.LoadFromFile (strPicPath) | |
Set objXML = CreateObject("MSXml2.DOMDocument") | |
Set objDocElem = objXML.createElement("Base64Data") | |
objDocElem.DataType = "bin.base64" | |
objDocElem.nodeTypedValue = objStream.Read() | |
EncodeFile = objDocElem.text | |
Set objXML = Nothing | |
Set objDocElem = Nothing | |
Set objStream = Nothing | |
End Function |
(四)通过 VBA 调用企业微信群机器人
将图片组建成 json 格局传值给机器人函数,而后间接发送
Public Function BotPic(Picname As String, url As String, Optional PicPth As String) As String | |
Dim params As String, ibase64 As String, imd5 As String | |
Dim strPicPath As String | |
' 输出的 PicPth 为空则应用以后文件所在门路作为门路 | |
If PicPth = "" Then PicPth = ActiveWorkbook.Path | |
strPicPath = PicPth & "\" & Picname & ".jpg" | |
' 获取 base64 转码 | |
ibase64 = EncodeFilebase64(strPicPath) | |
' 获取 MD5 转码 | |
Call MD5File(strPicPath) | |
imd5 = LCase(GetMD5Text()) | |
' 发送内容构建成 json 格局 | |
para1 = "{""msgtype"":""image"",""image"":{""base64"":""" | |
para2 = """,""md5"":""" | |
para3 = """}}" | |
params = para1 & ibase64 & para2 & imd5 & para3 | |
BotPic = HttpRequest(url, "POST", params) | |
End Function |
正文完