Soyez le premier à donner votre avis sur cette source.
Snippet vu 13 693 fois - Téléchargée 27 fois
Private Sub import() 'auteur Gnieark, le cri du cochon fou! Dim ligne, x As Integer ligne = 1 Dim filename, prout As String filename = "G:\gestion doc en prgramation\haha.txt" Dim docligne() As String Dim table(1 To 1000, 1 To 50) As String Open filename For Input As #1 While Not EOF(1) Line Input #1, prout docligne = Split(prout, ";") x = 1 For Each elem In docligne table(ligne, x) = elem x = x + 1 Next elem ligne = ligne + 1 Wend Close #1 End Sub
Au retour de la fonction, il suffit de faire:
Dim r As Boolean, szErr As String
Dim t() As String
Dim nb_lignes as long, nb_champs as long
r = ImportTxtFile("c:\test.dat", ";", t(), szErr, 1)
' RECUP NOMBRE LIGNES
nb_lignes = Ubound(t(), 1)
Tu peux aussi récupérer le nombre de champs:
nb_champs = Ubound(t(), 2)
pour la suite je vais tenter d'intégrer à ta fonction une variable contenant le nombre de lignes du texte.
Si j'y arrive pas j'appellerai à l'aide ;)
gnieark => Pour préserver ton tableau, il suffit que celui ci soit déclaré ailleurs que dans ta fonction.
VOici un exemple d'amélioration pour ta Sub:
- C'est maintenant une fonction qui retourne un booléen (True si tout va bien, False en cas d'erreur)
- Elle prend en paramètre le nom de fichier, le séparateur à utiliser, le tableau (qui sera alooué dynamiquement), une variable pour mettre le code d'erreur au cas ou (fichier non trouvé par exemple), et en option une variable permettant de commencer à remplir ton tableau à l'indice voulu (en général 0 ou 1).
Private Function ImportTxtFile(ByVal fileName As String, _
ByVal separator As String, _
ByRef tData() As String, _
ByRef errorString As String, _
Optional ByVal baseArray As Integer = 1) As Boolean
Dim f As Integer
Dim tLine() As String
Dim tSplit() As String
Dim buffer As String
Dim nbItem As Long
Dim i As Long, j As Long
On Error GoTo ImportTxtFile_ERR
f = FreeFile()
Open fileName For Binary As #f
buffer = Space$(LOF(f))
Get #f, , buffer
Close #f
tSplit() = Split(buffer, vbCrLf)
nbItem = UBound(Split(tSplit(0), separator)) + baseArray
ReDim tData(UBound(tSplit()) + baseArray, nbItem)
For i = LBound(tSplit()) To UBound(tSplit())
tLine = Split(tSplit(i), separator)
For j = LBound(tLine) To UBound(tLine)
tData(i + baseArray, j + baseArray) = tLine(j)
Next j
Next i
ImportTxtFile = True
ImportTxtFile_END:
Exit Function
ImportTxtFile_ERR:
errorString = Err.Description
Resume ImportTxtFile_END
End Function
Un exemple d'appel:
Private Sub Command2_Click()
Dim r As Boolean, szErr As String
Dim t() As String
r = ImportTxtFile("c:\test.dat", ";", t(), szErr, 1)
End Sub
Avantages:
- Tout est passé en paramètres, plus rien de hard-codé dans la "Sub"
- L'allocation du tableau est dynamique, aussi bien pour les lignes que pour les colonnes: tu peux lire n'importe quel fichier, de n'importe quelle taille, le code est toujours valable
- La lecture en bloc est très rapide
- C'est une vraie fonction, utilisable de façon autonome.
Au final, ça charge un fichier de 20000 lignes avec 7 champs par lignes en 0,4 seconde.
Bonne suite :-)
Au fait vu ton niveau très appréciable pourras-tu me faire des remarques et suggestions pour son amélioration?
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.