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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
| '**************************************************************************************************
' NAME : MOFX (MODULE)
' VERSION : 0.1
' AUTHOR : John Mc Evee
' DESCRIPTION : Processus permettant de parser un fichier OFX et retourne un ensemble de dictionnaire
'
'**************************************************************************************************
Option Explicit
Private lBuffer As Long
Private sBuffer As String
'**************************************************************************************************
' NAME : Start (PROCESS)
' INPUT : None
' OUTPUT : None
'**************************************************************************************************
Public Sub Start()
Dim oOFX As Dictionary
Dim SubItem As Dictionary
Dim sFilename As String
Dim sText As String
sFilename = "C:\Users\John\Desktop\OFX test.ofx"
sText = ReadFile(sFilename)
Set oOFX = ParseOFX(sText)
sText = vbNullString
End Sub
'**************************************************************************************************
' NAME : ParseOFX (FUNCTION)
' INPUT : sPathFile (string)
' OUTPUT : * sText (String), lBuffer (Long)
'**************************************************************************************************
Private Function ParseOFX(ByVal sText As String, Optional ByRef lBuffer As Long = 1) As Dictionary
Dim OFX As New Dictionary
Dim sKey As String
sText = VBA.Replace(VBA.Replace(VBA.Replace(sText, VBA.vbCr, ""), VBA.vbLf, ""), VBA.vbTab, "")
If Compliance(sText) Then
Do
lBuffer = Skip(sText, lBuffer)
Select Case VBA.Mid$(sText, lBuffer, 1)
Case "/"
If VBA.Mid$(sText, lBuffer - 1, 1) = "<" Then
Do
lBuffer = lBuffer + 1
Loop While VBA.Mid$(sText, lBuffer, 1) = ">"
Exit Do
End If
Case "<"
If VBA.Mid$(sText, lBuffer + 1, 1) = "/" Then
Do
lBuffer = lBuffer + 1
Loop While VBA.Mid$(sText, lBuffer, 1) <> ">"
Exit Do
Else
lBuffer = Skip(sText, lBuffer)
sKey = AddKey(sText, lBuffer)
If VBA.Mid$(sText, lBuffer + 1, 1) = "<" Then
OFX.Add sKey, ParseOFX(sText, lBuffer)
Else
OFX.Add sKey, AddItem(sText, lBuffer)
End If
End If
Case Else
lBuffer = lBuffer + 1
End Select
If lBuffer > VBA.Len(sText) Then Exit Do
Loop
End If
Set ParseOFX = OFX
End Function
'**************************************************************************************************
' NAME : Skip (FUNCTION)
' INPUT : sText (String), lBuffer (long)
' OUTPUT : lBuffer (Long)
'**************************************************************************************************
Private Function Skip(ByRef sText As String, ByRef lBuffer As Long) As Long
If Not VBA.Mid$(sText, lBuffer, 1) = "<" Then
lBuffer = lBuffer + 1
ElseIf VBA.Mid$(sText, lBuffer, 1) = vbNullString Then
lBuffer = lBuffer + 1
End If
Skip = lBuffer
End Function
'**************************************************************************************************
' NAME : AddKey (FUNCTION)
' INPUT : sText (String), lBuffer (long)
' OUTPUT : sBuffer (String)
'**************************************************************************************************
Private Function AddKey(ByRef sText As String, ByRef lBuffer As Long) As String
sBuffer = vbNullString
lBuffer = lBuffer + 1
Do
sBuffer = sBuffer & VBA.Mid$(sText, lBuffer, 1)
lBuffer = lBuffer + 1
Loop While VBA.Mid$(sText, lBuffer, 1) <> ">"
AddKey = sBuffer
End Function
'**************************************************************************************************
' NAME : AddItem(FUNCTION)
' INPUT : sText (String), lBuffer (long)
' OUTPUT : sBuffer(String)
'**************************************************************************************************
Private Function AddItem(ByRef sText As String, ByRef lBuffer As Long) As String
sBuffer = vbNullString
lBuffer = lBuffer + 1
Do
sBuffer = sBuffer & VBA.Mid$(sText, lBuffer, 1)
lBuffer = lBuffer + 1
Loop While VBA.Mid$(sText, lBuffer, 1) <> "<"
AddItem = sBuffer
End Function
'**************************************************************************************************
' NAME : Compliance (FUNCTION)
' INPUT : sText (String)
' OUTPUT : True/False (Boolean)
'**************************************************************************************************
Private Function Compliance(ByRef sText As String) As Boolean
If VBA.InStr(sText, "<OFX>") <> 0 And VBA.InStr(sText, "</OFX>") <> 0 Then
Compliance = True
Else
Compliance = False
End If
End Function
'**************************************************************************************************
' NAME : ReadFile (FUNCTION)
' INPUT : sPathFile (string)
' OUTPUT : ReadFile (string array)
' SOURCE : https://warin.developpez.com/access/fichiers/#LII-B-1
'**************************************************************************************************
Private Function ReadFile(ByVal sPathFile As String) As String
Const FUNCTION_NAME As String = "ReadFile"
On Error GoTo HANDLER_READFILE
Dim lMemory As Long
Dim lBuffer As Long
Dim sTabBuffer() As String
Dim sBuffer As String
Dim sTemp As String
lMemory = FreeFile
lBuffer = 1
Open sPathFile For Input As #lMemory
While Not EOF(lMemory)
If Not lBuffer = 1 Then
sBuffer = sBuffer & vbNewLine
Line Input #lMemory, sTemp
Else
Line Input #lMemory, sTemp
End If
sBuffer = sBuffer & sTemp
lBuffer = lBuffer + 1
Wend
Close (lMemory)
ReadFile = sBuffer
Exit Function
HANDLER_READFILE:
ReadFile = vbNullString
Err.Clear
End Function |
Parser un fichier OFX - Doublons de clés
Répondre avec citation
Partager