codice:
Public Function ReadFileTxtRighe(Optional NomeFileInput, _
Optional RigaStart, _
Optional RigaEnd, _
Optional ByVal StrExclude0, Optional ByVal StrExclude1, Optional ByVal StrExclude2, _
Optional ByVal StrExclude3, Optional ByVal StrExclude4, Optional ByVal StrExclude5, _
Optional StrExclude6 As Variant, Optional vuoto As Variant = 0) As Variant
'
' VARIABILI IN INPUT DELLA FUNZIONE:
' NomeFileInput: nome del file di input
' RigaStart: numero di riga, rispetto all'inizio del file, da cui far partire la lettura del file (impostato di default sul valore 0 per far partire la lettura dall'inizio)
' RigaEnd: numero riga, rispetto all'inizio del file, a cui far terminare la lettura del file
' StrExclude da 0 a 6: 7 stringhe in cui inserire le parole contenute nelle righe coprese tra Start e End che non si vuole vengano caricate
'
' FUNZIONI RICHIAMATE:
' Function FilePath_Default(NomeFileInput As String) As String
'
' *** COSA FA' QUESTA FUNZIONE:
' Questa funzione va a leggere il file di testo nel percorso che viene dato nel MsgBox e
' restituisce ReadFileTxt_Righe come array di stringhe contenente ciascuna dalle righe del file di testo.
' Vengono saltate le righe vuote
' Se dichiaro la variabile Str1, nel MsgBox viene impostato un indirizzo preferenziale per il file di input
'
' **********************************************************************************************************
' CORPO DELLA FUNZIONE
'
' DICHIARAZIONE VARIABILI
' Dichiaro le variabili per l'indirizzo del file di input
Dim FilePath As Variant ' variabile in cui memorizzo il percorso del file di input
'
' Dichiaro le viariabili per la lettura del file di input
Dim FileNumber As Integer ' variabile in cui memorizzo il numero di apertura file usato dall'istruzione open
Dim righe() As Variant ' array in cui memorizzo come stringhe le righe del file di input
Dim Default_path ' indirizzo di default file di input
Dim i, j, k As Long ' Contatori per i cicli
'
' Dichiaro le variabili per i messaggi di errore
Dim MsgError As String ' variabile utilizzata per caricare i messaggi di errore
Dim Response As String ' variabile usata per restituire i messaggi di errore
'
' Dichiaro le variabili per le operazioni di filtro dei dati da carica
Dim StrExclude() As Variant
Dim NumStrExclude As Integer
'
' DICHIARO LE COSTANTI
NumStrExclude = 7 ' Numero massimo delle stringhe che vengono cercate per escludere delle righe che non si vogliono caricare
ReDim StrExclude(NumStrExclude) ' Do le dimensioni all'array delle stringhe cercate per escludere delle righe che non si vogliono caricare
StrExclude(0) = StrExclude0: StrExclude(1) = StrExclude1: StrExclude(2) = StrExclude2: StrExclude(3) = StrExclude3: StrExclude(4) = StrExclude4
StrExclude(5) = StrExclude5: StrExclude(6) = StrExclude6
'
'
' INIZIALIZZO LE VARIABILI
' ReadFileTxt_Righe = vbNullChar ' inizializzo a zero il valore della function
FilePath = vbNullChar
FileNumber = 0
Default_path = vbNullChar
MsgError = vbNullChar
Response = vbNullChar
'
' ISTRUZIONI DELLA FUNCTION
'
' Carico indirizzo del file di input (viene proposto un indirizzo di default)
If IsMissing(NomeFileInput) Or Len(NomeFileInput) = 0 Then
GoSub Error2
Response = MsgBox(MsgError, , "MESSAGE ERROR!!!")
FilePath = InputBox("Inserisci il percorso del file di input", "Percoro File")
Else
Default_path = FilePath_Default(NomeFileInput) ' richiamo la function FilePath_Default per costruire l'indirizzo di default proprosto del file di input
FilePath = InputBox("Inserisci il percorso del file di input", "Percoro File", Default_path)
End If
'
' Controllo che l'indirizzo del file passato sia corretto
If FilePath = vbNullChar Or Len(FilePath) = 0 Then
GoSub Error1
Response = MsgBox(MsgError, , "MESSAGE ERROR!!!")
Exit Function
Else
End If
' Apertura del file di input e lettura integrale del file
'
FileNumber = FreeFile 'ottiene un numero di file libero
Open FilePath For Input Access Read As #FileNumber
i = 0
While Not EOF(FileNumber)
ReDim Preserve righe(i)
Line Input #FileNumber, righe(i)
i = i + 1
Wend
'
Close #FileNumber
'
' Elimino le righe che non mi interessano secondo i criteri definiti con le variabili passate alla function
'
If IsMissing(RigaStart) Then
RigaStart = 0 ' Se la variabile RigaStart non è fornita, vengono caricate le righe a partire dall'inizio del file
Else
End If
If IsMissing(RigaEnd) Then
RigaEnd = UBound(righe) ' Se la variabile RigaEnd non è fornita, vengono caricate tutte le righe da RigaStart fino alla fine del file
Else
End If
'
'
i = 0: j = 0
For i = 0 To UBound(righe)
If i < RigaStart Or i > RigaEnd Then
righe(i) = vbNullChar
ElseIf _
Len(righe(i)) = 0 Then
righe(i) = vbNullChar
ElseIf _
righe(i) = " " Then
righe(i) = vbNullChar
Else
For j = 0 To (NumStrExclude - 1) Step 1
If IsMissing(StrExclude(j)) Then
ElseIf _
InStr(StrExclude(j), righe(i), 1) > 0 Then
righe(i) = vbNullChar
End If
Next j
End If
Next
'
ReadFileTxtRighe = Filter(righe, vbNullChar, False) 'carico le stringhe eliminando tutte le righe vuote
'
Exit Function 'per far terminare la function altrimenti ontinua con le righe sotto.
'
' MESSAGGI DI ERRORE
Error1: MsgError = "Non è stato passato il percorso del file di input - la stringa è vuota"
Return
Error2: MsgError = "Non è stato passato il nome del file di input (la stringa è vuota)" & Chr(13) & "Inserire il Nome del file nella finestra successiva"
Return
'
'
End Function
' **********
Sub prova2()
Dim p
Dim r
p = Worksheets("Input").Cells(55, 6).Value
r = ReadFileTxtRighe(p, , 2357, , , , , , , , 0)
'
End Sub
Rispondi quotando
