Discussion :

[ddams]

Bonjour,

Je me permets de vous soumettre une petite question vbs.

Contexte
Je dois appeler un service web soap. Service auquel je passe un fichier excel et qui me retourne une URL.
Mon problème est que l'envoi du fichier doit se faire sous forme d'une chaine binaire en base 64.

Ma question
Comme c'est une opération que je n'ai jamais réalisé, je me pose la question de comment convertir mon fichier excel en une chaine binaire en base 64 ?

Je sèche un peu et suis donc preneur de tout bout de code pour faire ça.

Merci d'avance à tous ceux qui prendront le temps de me lire.

[ddams]

Comme ça peut servir à d'autres, voici la solution mise en oeuvre :

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
 
'============================================================================================
'-- Titre : getBase64StringFromFile
'-- Description : Permet d'obtenir la chaine binaire base 64 correspondant au fichier
'-- Auteur : ddams - 02/09/2010
'============================================================================================
function getBase64StringFromFile(astrFilePath)
	binary = ReadBinaryFile(astrFilePath)
	stringBinary = BinaryToString(binary)
	getBase64StringFromFile = Base64Encode(stringBinary)
end function
 
 
'============================================================================================
'-- Titre : ReadBinaryFile
'-- Description : Permet la lecture d'un fichier binaire
'-- Auteur : http://www.motobit.com/tips/detpg_read-write-binary-files/
'============================================================================================
Function ReadBinaryFile(FileName)
  Const adTypeBinary = 1
 
  'Create Stream object
  Dim BinaryStream
  Set BinaryStream = CreateObject("ADODB.Stream")
 
  'Specify stream type - we want To get binary data.
  BinaryStream.Type = adTypeBinary
 
  'Open the stream
  BinaryStream.Open
 
  'Load the file data from disk To stream object
  BinaryStream.LoadFromFile FileName
 
  'Open the stream And get binary data from the object
  ReadBinaryFile = BinaryStream.Read
End Function
 
 
'============================================================================================
'-- Titre : BinaryToString
'-- Description : Permet d'obtenir la chaine correspondant à un binaire
'-- Auteur : http://www.motobit.com/tips/detpg_read-write-binary-files/
'============================================================================================
Function BinaryToString(Binary)
  'Antonin Foller, http://www.motobit.com
  'Optimized version of a simple BinaryToString algorithm.
 
  Dim cl1, cl2, cl3, pl1, pl2, pl3
  Dim L
  cl1 = 1
  cl2 = 1
  cl3 = 1
  L = LenB(Binary)
 
  Do While cl1<=L
    pl3 = pl3 & Chr(AscB(MidB(Binary,cl1,1)))
    cl1 = cl1 + 1
    cl3 = cl3 + 1
    If cl3>300 Then
      pl2 = pl2 & pl3
      pl3 = ""
      cl3 = 1
      cl2 = cl2 + 1
      If cl2>200 Then
        pl1 = pl1 & pl2
        pl2 = ""
        cl2 = 1
      End If
    End If
  Loop
  BinaryToString = pl1 & pl2 & pl3
End Function
 
'============================================================================================
'-- Titre : Base64Encode
'-- Description : Permet l'encodage en base 64 d'une chaine binaire
'-- Auteur : http://www.motobit.com/tips/detpg_base64encode/
'============================================================================================
Function Base64Encode(inData)
  'rfc1521
  '2001 Antonin Foller, Motobit Software, http://Motobit.cz
  Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  Dim cOut, sOut, I
 
  'For each group of 3 bytes
  For I = 1 To Len(inData) Step 3
    Dim nGroup, pOut, sGroup
 
    'Create one long from this 3 bytes.
    nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
      &H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))
 
    'Oct splits the long To 8 groups with 3 bits
    nGroup = Oct(nGroup)
 
    'Add leading zeros
    nGroup = String(8 - Len(nGroup), "0") & nGroup
 
    'Convert To base64
    pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
 
    'Add the part To OutPut string
    sOut = sOut + pOut
 
    'Add a new line For Each 76 chars In dest (76*3/4 = 57)
    'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
  Next
  Select Case Len(inData) Mod 3
    Case 1: '8 bit final
      sOut = Left(sOut, Len(sOut) - 2) + "=="
    Case 2: '16 bit final
      sOut = Left(sOut, Len(sOut) - 1) + "="
  End Select
  Base64Encode = sOut
End Function
Function MyASC(OneChar)
  If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function