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

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

  1. 将Excel工作表的指定区域保留为图片
  2. 获取保留的图片的MD5和Base64
  3. 将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 WithEnd Function

（二）用VBA获取文件MD5

倡议封装为模块，调用MD5File(文件门路)

Option ExplicitType MD5_CTX      dwNUMa      As Long      dwNUMb      As Long      Buffer(15)  As Byte      cIN(63)     As Byte      cDig(15)    As ByteEnd TypePrivate 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.cDigEnd 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.cDigEnd 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.cDigEnd 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 FunctionPublic 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 = NothingEnd 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