You signed in with another tab or window. Reload to refresh your session.You signed out in another tab or window. Reload to refresh your session.You switched accounts on another tab or window. Reload to refresh your session.Dismiss alert
.ImportFromCSV .parseConfig ' Import the CSV to internal object
48
+
End With
49
+
End Sub</pre>
50
+
51
+
<p>Now suppose from the file "<em>Sample.csv</em>" the user only requires to import a specific range of records. It is possible to write a code like the one shown below:</p>
52
+
53
+
<prelang="vbscript">
54
+
Sub CSVimportRecordsRange()
55
+
Dim CSVint As CSVinterface
56
+
57
+
Set CSVint = New CSVinterface
58
+
With CSVint.parseConfig
59
+
.path = "C:\Sample.csv"' Full path to the file, including its extension.
.ImportFromCSV .parseConfig ' Import the CSV to internal object
84
+
.Sort SortColumn:=1, Descending:=True ' Sort imported data on first column
85
+
End With
86
+
End Sub</pre>
87
+
88
+
<p>CSV data are mainly treated as text strings, what if the user wants to do some calculations on the data obtained from a given file? In this situation, the user can change the behavior of the parser to work in dynamic typing mode. Here's an example:</p>
89
+
90
+
<prelang="vbscript">
91
+
Sub CSVimportAndTypeData()
92
+
Dim CSVint As CSVinterface
93
+
94
+
Set CSVint = New CSVinterface
95
+
With CSVint.parseConfig
96
+
.path = "C:\Sample.csv"' Full path to the file, including its extension.
<p>Once the data is imported and saved to the internal object, the user can access it in the same way as a standard VBA array. An example would be:</p>
133
+
134
+
<prelang="vbscript">
135
+
Sub LoopData(ByRef CSVint As CSVinterface)
136
+
With CSVint
137
+
Dim iCounter As Long
138
+
Dim cRecord() As Variant ' Records are stored as a one-dimensional array.
139
+
Dim cField As Variant
140
+
141
+
For iCounter = 0 To CSVint.count - 1
142
+
cRecord() = .item(iCounter) ' Retrieves a record
143
+
cField = .item(iCounter, 2) ' Retrieves the 2nd field of the current record
144
+
Next
145
+
End With
146
+
End Sub</pre>
147
+
148
+
<p>However, it is sometimes disadvantageous to store data in containers other than VBA arrays. This becomes especially noticeable when it is required to write the information stored in Excel's own objects, such as spreadsheets, or VBA user forms, the case of list boxes, which allow to be filled in a single instruction using arrays. Then, the user can copy the information from the internal object using code like this:</p>
149
+
150
+
<prelang="vbscript">
151
+
Sub DumpData(ByRef CSVint As CSVinterface)
152
+
Dim oArray() As Variant
153
+
With CSVint
154
+
.DumpToArray oArray ' Dump the internal data into a two-dimensional array
155
+
.DumpToJaggedArray oArray ' Dump the internal data into a jagged array
156
+
.DumpToSheet ' Dump the internal data into a new sheet
' *NOTE: ONLY AVAILABLE FOR THE ACCESS VERSION OF THE CSV INTERFACE
160
+
' Dump the internal data into the Table1 in oAccessDB database.
161
+
' The method would create indexes in the 2nd and 3th fields.
162
+
.DumpToAccessTable oAccessDB, _
163
+
"Table1", _
164
+
2, 3
165
+
End With
166
+
End Sub</pre>
167
+
168
+
<p>So far, in the examples addressed, the user has been allowed to choose between two actions:</p>
169
+
170
+
<ol>
171
+
<li>Import <em>ALL records</em> contained in a CSV file.</li>
172
+
<li>Import a <em>recordset</em>, starting at record X and ending at record Y.</li>
173
+
</ol>
174
+
175
+
<p>In both options, the user is obliged to import all fields (columns) present in the file. Most CSV file parsers only offer the first option, but what if the user wants to save only the information that is relevant to them? and what happens is intended to store in memory only the registers that meet a certain set of requirements?</p>
176
+
177
+
<p>An user may need to import 2 of 12 columns from a CSV file, in this case, the user can use something like:</p>
178
+
179
+
<prelang="vbscript">
180
+
Sub CSVimportDesiredColumns()
181
+
Dim CSVint As CSVinterface
182
+
183
+
Set CSVint = New CSVinterface
184
+
With CSVint.parseConfig
185
+
.path = "C:\Sample.csv"' Full path to the file, including its extension.
1, "Revenue"' Import 1st and "Revenue" fields ONLY
192
+
End With
193
+
End Sub</pre>
194
+
195
+
<p>So, OK, let's imagine now that an user wants to apply some logic before saving the data, in which case they can step through the records in the CSV file one by one, using the sequential reader, as shown in the following example:</p>
196
+
197
+
<prelang="vbscript">
198
+
Sub CSVsequentialImport()
199
+
Dim CSVint As CSVinterface
200
+
Dim csvRecord As ECPArrayList
201
+
202
+
Set CSVint = New CSVinterface
203
+
With CSVint.parseConfig
204
+
.path = "C:\Sample.csv"' Full path to the file, including its extension.
Loop While Not csvRecord Is Nothing ' Loop until the end of the file is reached
218
+
End With
219
+
End Sub</pre>
220
+
221
+
<p>Is there a way to sequentially fetch a set of records at a time instead of a single record? Currently, there is no built-in method to do that with a single instruction, as in the examples above, but with a few extra lines of code and the tools provided by the library, it is possible to achieve that goal. This is illustrated in the following example where the CSV file is streamed:</p>
.endStreamOnLineBreak = True ' Instruct to find line breaks
236
+
.OpenStream "C:\Sample.csv"' Connect to CSV file
237
+
Do
238
+
.ReadText ' Read a CSV chunk
239
+
CSVint.ImportFromCSVString .bufferString, _
240
+
CSVint.parseConfig, _
241
+
1, "Revenue"' Import a set of records
242
+
'//////////////////////////////////////
243
+
'Implement your logic here
244
+
'//////////////////////////////////////
245
+
Loop While Not .atEndOfStream ' Continue until reach
246
+
' the end of the CSV file.
247
+
End With
248
+
Set CSVint = Nothing
249
+
Set StreamReader = Nothing
250
+
End Sub</pre>
251
+
252
+
<p>So far, it has been outlined the way in which you can import the records from a CSV file sequentially, the following example shows how to filter the records, in a like SQL way, according to whether they meet a criterion set by the user:</p>
253
+
254
+
<prelang="vbscript">
255
+
Sub QueryCSV(path As String, ByVal keyIndex As Long, queryFilters As Variant)
' The following instruction will filter the data
268
+
' on the keyIndex(th) field.
269
+
Set CSVrecords = CSVint.GetCSVsubset(path, _
270
+
queryFilters, _
271
+
keyIndex)
272
+
CSVint.DumpToSheet DataSource:=CSVrecords ' Dump result to new WorkSheet
273
+
Set CSVint = Nothing
274
+
Set CSVrecords = Nothing
275
+
End If
276
+
End Sub</pre>
277
+
278
+
<p>In some situations, we may encounter a CSV file with a combination of <code>vbCrLf</code>, <code>vbCr</code> and <code>vbLf</code> as record delimiters. This can happen for many reasons, but the most common is by adding data to an existing CSV file without checking the configuration of the previously stored information. These cases will break the logic of many robust CSV parsers, including the demo of the 737K weekly downloaded <ahref="https://www.papaparse.com/demo">Papa Parse</a>. The next example shows how an user can import CSV files with mixed line break as record delimiter, an option that uses the <code>turnStreamRecDelimiterToLF</code> property of the <ahref="https://ws-garcia.github.io/VBA-CSV-interface/api/properties/parseconf.html"><code>parseConfig</code></a> object to work with these special CSV files.</p>
.turnStreamRecDelimiterToLF = True ' All delimiters will be turned into vbLf
290
+
End With
291
+
With CSVint
292
+
.ImportFromCSV .parseConfig
293
+
End With
294
+
Set CSVint = Nothing
295
+
End Sub</pre>
296
+
297
+
<p>In all the above examples, an implicit assumption has been made, and that is that the user knows the configuration of the CSV file to be imported, so the question arises: can it be possible that the user does not know the configuration of the file to be imported? It is certainly possible, so how can the CSV interface help in these cases?</p>
298
+
299
+
<p>The tool includes a utility to guess field delimiters, record delimiters and escape character. This can be done with code like the following:</p>
300
+
301
+
<prelang="vbscript">
302
+
Sub DelimitersGuessing()
303
+
Dim CSVint As CSVinterface
304
+
305
+
Set CSVint = New CSVinterface
306
+
With CSVint.parseConfig
307
+
.path = "C:\Sample.csv"' Full path to the file, including its extension.
308
+
End With
309
+
With CSVint
310
+
.GuessDelimiters .parseConfig ' Try to guess delimiters and save to internal
' *NOTE: the user can also create a custom configuration object
314
+
' and try to guess the delimiter with it.
315
+
End With
316
+
End Sub</pre>
317
+
30
318
## Contributing
31
319
32
320
In order to contribute within this project, please see the [guidance for contributing](https://ws-garcia.github.io/VBA-CSV-interface/contributing.html).
0 commit comments