News
VMware vConverter torna un errore o un warning per Sysprep?
Ecco la soluzione!
Classe in VB per leggere File testo di tipo Tab Delimited
La classe espone le proprietà:
PathFile: stringa che contiene il path completo del file testo (c:\miacartella\miofile.txt)
Headings: booleano, vero se voglio le intestazioni delle colonne, falso altrimenti.
Il metodo Parse torna un array di array per cui è possibile recuperare i dati del file testo ad esempio mendiante due loop annidati.
Esempio:
Dim TextParser as New TDParser
Dim result (), riga, colonna
TextParser.PathFile = "c:\miacartella\miofile.txt"
TextParser.Headings = True
result = TextParser.Parse
For Each riga In result
DoEvents
For Each colonna in riga
DoEvents
msgbox colonna
Next
Next
Ecco la classe TDParser.cls
Private mvarPathFile As String 'local copy
Private mvarHeadings As Boolean 'local copy
Public Property Let Headings(ByVal vData As Boolean)
mvarHeadings = vData
End Property
Public Property Get Headings() As Boolean
Headings = mvarHeadings
End Property
Public Property Let PathFile(ByVal vData As String)
mvarPathFile = vData
End Property
Public Property Get PathFile() As String
PathFile = mvarPathFile
End Property
Public Function Parse() As Variant
Dim objFileSystem As New FileSystemObject
Dim objTextStream As TextStream
Dim myfile As File
Dim strLine As String
Dim strLineArray
Dim strFileArray()
Dim i As Integer
Dim flgFileVuoto As Boolean
flgFileVuoto = True
'apro il file, specificato tramite il path mvarTextFile
'in modalità lettura
Set myfile = objFileSystem.GetFile(mvarPathFile)
Set objTextStream = myfile.OpenAsTextStream(ForReading, TristateUseDefault)
i = 0
'ripeto per ogni riga del file
While Not objTextStream.AtEndOfStream
flgFileVuoto = False
'leggo una riga
strLine = objTextStream.ReadLine
'spezzo la riga: ogni stringa delimitata da TAB diventa elemento di un array
strLineArray = Split(strLine, vbTab)
'l'array cosi' formato diventa a sua volta elemento di un altro array
'alla fine avro' un array che contiene tanti array di stringhe
'quante sono le righe dal file originale
ReDim Preserve strFileArray(i)
strFileArray(i) = strLineArray
i = i + 1
Wend
'se voglio togliere l'heading dal risultato allora tolgo
'il primo elemento dell'array di array
If flgFileVuoto = False Then
If mvarHeadings = False Then
ArrayRemoveItem strFileArray, 0
End If
End If
'libero memoria
objTextStream.Close
Set objTextStream = Nothing
Set myfile = Nothing
'torna il risultato
Parse = strFileArray
End Function
Private Sub ArrayRemoveItem(ItemArray As Variant, ByVal ItemElement As Long)
'PURPOSE: Remove an item from an array, then
' resize the array
'PARAMETERS: ItemArray: Array, passed by reference, with
' item to be removed. Array must not be fixed
' ItemElement: Element to Remove
'EXAMPLE:
' dim iCtr as integer
' Dim sTest() As String
' ReDim sTest(2) As String
' sTest(0) = "Hello"
' sTest(1) = "World"
' sTest(2) = "!"
' ArrayRemoveItem sTest, 1
' for iCtr = 0 to ubound(sTest)
' Debug.print sTest(ictr)
' next
'
' Prints
'
' "Hello"
' "!"
' To the Debug Window
Dim lCtr As Long
Dim lTop As Long
Dim lBottom As Long
If Not IsArray(ItemArray) Then
Err.Raise 13, , "Type Mismatch"
Exit Sub
End If
lTop = UBound(ItemArray)
lBottom = LBound(ItemArray)
If ItemElement < lBottom Or ItemElement > lTop Then
Err.Raise 9, , "Subscript out of Range"
Exit Sub
End If
For lCtr = ItemElement To lTop - 1
ItemArray(lCtr) = ItemArray(lCtr + 1)
Next
On Error GoTo ErrorHandler:
ReDim Preserve ItemArray(lBottom To lTop - 1)
Exit Sub
ErrorHandler:
'An error will occur if array is fixed
Err.Raise Err.Number, , _
"You must pass a resizable array to this function"
End Sub