Excel VBA通过企业微信群机器人发送工作表区域截图

2022-09-30 约 1351 字预计阅读 3 分钟

前言

在传统行业，用Excel做表比通过Python操作更加普遍，Excel也可以通过VBA实现报表自动化：自动更新数据，用公式/代码生成点评，通过Outlook自动群发邮件，嵌入代码的xlsm可以直接发送给其他人使用，无需打包成exe…于是企微机器人传值这种Python几行代码的事情也只能捏着鼻子上那么一百几十行VBA了。

本文代码解决流程中3个主要步骤：

将Excel工作表的指定区域保存为图片
获取保存的图片的MD5和Base64
将MD5和Base64组成json格式发送企微提供的Webhook

（一）保存图片示例代码

注意

保存的图片有可能为空白，可以增加文件大小校验。

 1Public Function RangeToPic(Rng As Range)
 2    '使用当前文件所在路径作为输出路径
 3
 4    Pth = ActiveWorkbook.Path
 5
 6    '使用【文件名_区域地址】作为输出文件名
 7
 8    Pnm = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1) & "_" & Replace(Rng.Address(0, 0), ":", "_")
 9    
10    '把选择范围内容转化为截屏图片信息
11
12    Rng.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
13    With ActiveSheet.ChartObjects.Add(0, 0, Rng.Width + 1, Rng.Height + 1).Chart
14        .ChartArea.Border.LineStyle = 0
15        .Parent.Select
16        .Paste
17        .Export Pth & "\" & Pnm & ".png", "PNG"
18        .Parent.Delete
19    End With
20
21End Function

（二）用VBA获取文件MD5

建议封装为模块，使用时调用MD5File(文件路径)

 1Option Explicit
 2Type MD5_CTX
 3      dwNUMa      As Long
 4      dwNUMb      As Long
 5      Buffer(15)  As Byte
 6      cIN(63)     As Byte
 7      cDig(15)    As Byte
 8End Type
 9
10Private Declare PtrSafe Sub MD5Init Lib "advapi32" (lpContext As MD5_CTX)
11Private Declare PtrSafe Sub MD5Final Lib "advapi32" (lpContext As MD5_CTX)
12Private Declare PtrSafe Sub MD5Update Lib "advapi32" (lpContext As MD5_CTX, ByRef lpBuffer As Any, ByVal BufSize As Long)
13Private stcContext   As MD5_CTX
14
15'计算一个字符串（ANSI编码）的MD5码：输入字符串文本，返回MD5码（16字节的Byte数组）
16
17Public Function MD5String(strText As String) As Byte()
18    Dim aBuffer() As Byte
19    Call MD5Init(stcContext)
20    If (Len(strText) > 0) Then
21        aBuffer = StrConv(strText, vbFromUnicode)
22        Call MD5Update(stcContext, aBuffer(0), UBound(aBuffer) + 1)
23    Else
24        Call MD5Update(stcContext, 0, 0)
25    End If
26    Call MD5Final(stcContext)
27    MD5String = stcContext.cDig
28End Function
29
30'计算一个字节流的MD5码：输入Byte数组和长度（可选，默认计算整个长度），返回MD5码 （16字节的Byte数组）
31
32Public Function MD5Bytes(Buffer() As Byte, _
33    Optional ByVal size As Long = -1) As Byte()
34    Dim U As Long, pBase As Long
35    
36    pBase = LBound(Buffer)
37    U = UBound(Buffer) - pBase
38    If (-1 = size) Then size = U + 1
39        Call MD5Init(stcContext)
40    If (-1 = U) Then
41        Call MD5Update(stcContext, 0, 0)
42    Else
43        Call MD5Update(stcContext, Buffer(pBase), size)
44    End If
45    Call MD5Final(stcContext)
46    MD5Bytes = stcContext.cDig
47End Function
48
49'计算一个文件的MD5码：输入磁盘文件名（完整路径），返回MD5码 （16字节的Byte数组）
50
51Public Function MD5File(ByVal FileName As String) As Byte()
52    Const BUFFERSIZE  As Long = 1024& * 512
53    Dim DataBuff() As Byte
54    Dim lFileSize  As Long
55    Dim iFn        As Long
56    
57    On Error GoTo E_Handle_MD5
58    If (Len(Dir$(FileName)) = 0) Then Err.Raise 5
59    
60    ReDim DataBuff(BUFFERSIZE - 1)
61    iFn = FreeFile()
62    Open FileName For Binary As #iFn
63    lFileSize = LOF(iFn)
64    Call MD5Init(stcContext)
65    
66    If (lFileSize = 0) Then
67        Call MD5Update(stcContext, 0, 0)
68    Else
69        Do While (lFileSize > 0)
70            Get iFn, , DataBuff
71            If (lFileSize > BUFFERSIZE) Then
72                Call MD5Update(stcContext, DataBuff(0), BUFFERSIZE)
73            Else
74                Call MD5Update(stcContext, DataBuff(0), lFileSize)
75            End If
76            lFileSize = lFileSize - BUFFERSIZE
77        Loop
78    End If
79    Close iFn
80    Call MD5Final(stcContext)
81E_Handle_MD5:
82    MD5File = stcContext.cDig
83End Function

（三）用VBA获取图片Base64

使用时调用EncodeFilebase64(文件路径)

 1Public Function EncodeFilebase64(strPicPath As String) As String
 2    Dim PicExtn As String, FLPath As String
 3    Dim StrPath As Variant
 4    Dim BSC As Long
 5    Dim fso As Object
 6    PicExtn = Split(strPicPath, ".")(1)
 7    FLPath = Replace(strPicPath, PicExtn, ".txt")
 8    EncodeFilebase64 = Replace(EncodeFile(strPicPath), Chr(10), "")
 9End Function
10
11Public Function EncodeFile(strPicPath As String) As String
12    Const adTypeBinary = 1
13    Dim objXML
14    Dim objDocElem
15    Dim objStream
16
17    Set objStream = CreateObject("ADODB.Stream")
18    objStream.Type = adTypeBinary
19    objStream.Open
20    objStream.LoadFromFile (strPicPath) 
21    Set objXML = CreateObject("MSXml2.DOMDocument")
22    Set objDocElem = objXML.createElement("Base64Data")
23    
24    objDocElem.DataType = "bin.base64"
25    objDocElem.nodeTypedValue = objStream.Read()
26    EncodeFile = objDocElem.text
27
28    Set objXML = Nothing
29    Set objDocElem = Nothing
30    Set objStream = Nothing
31End Function

（四）通过VBA调用企业微信群机器人

将图片组建成json格式传值给机器人函数，然后直接发送。

 1Public Function BotPic(Picname As String, url As String, Optional PicPth As String) As String
 2    Dim params As String, ibase64 As String, imd5 As String
 3    Dim strPicPath As String
 4    
 5    If PicPth = "" Then PicPth = ActiveWorkbook.Path
 6    strPicPath = PicPth & "\" & Picname & ".jpg"
 7    
 8    '获取base64转码
 9
10    ibase64 = EncodeFilebase64(strPicPath)
11    
12    '获取MD5转码
13
14    Call MD5File(strPicPath)
15    imd5 = LCase(GetMD5Text())
16    
17    '发送内容构建成json格式
18    
19    para1 = "{""msgtype"":""image"",""image"":{""base64"":"""
20    para2 = """,""md5"":"""
21    para3 = """}}"
22    params = para1 & ibase64 & para2 & imd5 & para3
23
24    BotPic = HttpRequest(url, "POST", params)
25End Function

目录

Excel VBA通过企业微信群机器人发送工作表区域截图

前言

（一）保存图片示例代码

（二）用VBA获取文件MD5

（三）用VBA获取图片Base64

（四）通过VBA调用企业微信群机器人