Discussion :

[Delbeke]

Ceci est plus une astuce qu'un vrai code
On utilise une référence As Ms XML, qui en sous produit, fait le codage/decodage du base 64

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Public Function Decode_Base64(Text As String) As String
  Dim Xml As New MSXML.DOMDocument
  Dim Conv As MSXML.IXMLDOMElement
  If Text = "" Then
    Decode_Base64 = ""
    Exit Function
  End If
  Set Conv = Xml.createElement("Base64")
  Conv.dataType = "bin.base64"
  Conv.Text = Text
  Decode_Base64 = StrConv(Conv.nodeTypedValue, vbUnicode)
End Function
Public Function Encode_Base64(Text As String) As String
  Dim Xml As New MSXML.DOMDocument
  Dim Conv As MSXML.IXMLDOMElement
  Dim Arr() As Byte
  If Text = "" Then
    Encode_Base64 = ""
    Exit Function
  End If
  Arr = StrConv(Text, vbFromUnicode)
  Set Conv = Xml.createElement("Base64")
  Conv.dataType = "bin.base64"
  Conv.nodeTypedValue = Arr
  Encode_Base64 = Conv.Text
End Function

[Delbeke]

J'ai rouvé une autre astuce en utilisant CAPICOM

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Public Function DecodeBase64(Text As String) As String
  Dim Utl As New CAPICOM.Utilities
  DecodeBase64 = StrConv(Utl.Base64Decode(Text), vbUnicode)
End Function
Public Function EncodeBase64(Text As String) As String
  Dim Utl As New CAPICOM.Utilities
  Dim iPnt As Integer
  EncodeBase64 = Utl.Base64Encode(StrConv(Text, vbFromUnicode))
  'je ne sais pas pourqoui, la fonction retourne une chaine terminée par CR+LF
  If Right(EncodeBase64, 2) = vbCrLf Then
    EncodeBase64 = Left(EncodeBase64, Len(EncodeBase64) - 2)
  End If
End Function