vba实现图片与base64编码的转换

1、填写引用和自定义类型，如下：

Type GUID

    Data1 As Long

    Data2 As Integer

    Data3 As Integer

    Data4(7) As Byte

End Type

Private Declare Function CreateStreamOnHGlobal Lib "ole32.dll" (ByRef hGlobal As Any, ByVal fDeleteOnResume As Long, ByRef ppstr As Any) As Long

Private Declare Function OleLoadPicture Lib "olepro32.dll" (ByVal lpStream As IUnknown, ByVal lSize As Long, ByVal fRunMode As Long, ByRef riid As GUID, ByRef lplpObj As Any) As Long

Private Declare Function CLSIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByRef pclsid As GUID) As Long

Private Const SIPICTURE As String = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"

2、编写将Base64转为数组的函数，如下：

Public Function decodeBase64(ByVal strData As String) As Byte()

'引入Microsoft XML,V6.0

    Dim objXML As MSXML2.DOMDocument

    Dim objNode As MSXML2.IXMLDOMElement

    Set objXML = New MSXML2.DOMDocument

    Set objNode = objXML.createElement("b64")

    objNode.dataType = "bin.base64"

    objNode.Text = strData

    decodeBase64 = objNode.nodeTypedValue

    Set objNode = Nothing

    Set objXML = Nothing

End Function

3、编写加将数组转为Ipicture的函数，如下：

Public Function PictureFromArray(ByRef b() As Byte) As IPicture

    On Error GoTo errorhandler

    Dim istrm As IUnknown

    Dim tGuid As GUID

    If Not CreateStreamOnHGlobal(b(LBound(b)), False, istrm) Then

        CLSIDFromString StrPtr(SIPICTURE), tGuid

        OleLoadPicture istrm, UBound(b) - LBound(b) + 1, False, tGuid, PictureFromArray

    End If

    Set istrm = Nothing

    Exit Function

errorhandler:

    Debug.Print "Could not convert to IPicture!"

End Function

4、编写将图片转为Base64编码的函数：

Public Function EncodeFile(strPicPath As String) As String

    Const adTypeBinary = 1          ' Binary file is encoded

' Variables for encoding

    Dim objXML

    Dim objDocElem

    ' Variable for reading binary picture

    Dim objStream

    ' Open data stream from picture

    Set objStream = CreateObject("ADODB.Stream")

    objStream.Type = adTypeBinary

    objStream.Open

    objStream.LoadFromFile (strPicPath)

    ' Create XML Document object and root node

    ' that will contain the data

    Set objXML = CreateObject("MSXml2.DOMDocument")

    Set objDocElem = objXML.createElement("Base64Data")

    objDocElem.dataType = "bin.base64"

    ' Set binary value

    objDocElem.nodeTypedValue = objStream.Read()

    ' Get base64 value

    EncodeFile = objDocElem.Text

    ' Clean all

    Set objXML = Nothing

    Set objDocElem = Nothing

    Set objStream = Nothing

End Function

5、窗体中添加按钮，实现将图片转为Base64编码并显示在整个文档，如下：

Private Sub CommandButton1_Click()

    With Application.FileDialog(msoFileDialogFilePicker)

        .AllowMultiSelect = False   '单选择

        .Filters.Clear   '清除文件过滤器

        .Filters.Add "Picture Files", "*.bmp;*.jpg;*.gif"

        .Filters.Add "All Files", "*.*"          '设置两个文件过滤器

        If .Show = -1 Then    'FileDialog 对象的 Show 方法显示对话框，并且返回 -1（如果您按 OK）和 0（如果您按 Cancel）。

            ThisDocument.Content.Text = EncodeFile(.SelectedItems(1))

        End If

    End With

End Sub

6、将Base64编码转为图片数组直接显示在图片控件中，如下：

Private Sub CommandButton2_Click()

    Dim str As String

    str = ThisDocument.Content.Text

    Image1.Picture = PictureFromArray(decodeBase64(str))

End Sub

说明：PNG格式的图片无法显示。

可交流分享经验，联系qq：329876601