Sub CréationFichierFournisseurAvecFiltreDate()
' Ultra rapide
Dim t As Single
Dim fournisseurs As String
Dim filePath As String
Dim FSO As Object
Dim myFile As Object
Dim RubGlobal As Collection
Dim x As Integer
Dim fichier As String
Dim ID As String
Dim Values As String
Dim fileHandles As Object
Dim fileHandle As Variant
Dim datedeb As Date
Dim datefin As Date
Dim dateValue As Date
' Définir les dates de début et de fin
datedeb = CDate("01/03/2022")
datefin = Date
' Chemin du fichier texte à ouvrir
filePath = Application.GetOpenFilename("Fichiers TXT (*.txt), *.txt")
If filePath = "Faux" Then Exit Sub ' Si l'utilisateur annule
' Timer
t = Timer
' Dossier (Fichier Fournisseurs)
fournisseurs = ThisWorkbook.Path & "\Fournisseurs\"
If Dir(fournisseurs, vbDirectory) = "" Then MkDir fournisseurs ' Crée le sous-dossier
fichier = Dir(fournisseurs & "*.csv")
' Test si le sous-dossier n'est pas vide, suppression de tous les fichiers
While fichier <> ""
Kill fournisseurs & fichier
fichier = Dir
Wend
' Instanciation des variables FSO et myFile
Set FSO = CreateObject("Scripting.FileSystemObject")
Set myFile = FSO.OpenTextFile(filePath, 1)
' Racine (Collection)
Set RubGlobal = New Collection
Values = myFile.ReadLine
RubGlobal.Add Item:=Values, Key:="L1"
' Dictionnaire pour gérer les fichiers ouverts
Set fileHandles = CreateObject("Scripting.Dictionary")
' Boucle Lire le fichier ligne par ligne
Do While Not myFile.AtEndOfStream
Values = myFile.ReadLine
ID = Split(Values, ";")(0)
' Vérifier si la date est dans la plage spécifiée
dateValue = CDate(Split(Values, ";")(7))
If dateValue >= datedeb And dateValue <= datefin Then
If Not fileHandles.Exists(ID) Then
' Créer le nom du fichier
fichier = fournisseurs & ID & ".csv"
' Ouvrir le fichier pour écriture séquentielle et stocker le handle dans le dictionnaire
fileHandle = FreeFile
Open fichier For Append As #fileHandle
fileHandles.Add ID, fileHandle
' Écrire l'entête
Print #fileHandle, RubGlobal.Item("L1")
Else
' Récupérer le handle du fichier déjà ouvert
fileHandle = fileHandles(ID)
End If
' Écrire la ligne dans le fichier correspondant
Print #fileHandle, Values
End If
Loop
' Fermer tous les fichiers ouverts
For Each fileHandle In fileHandles.Items
Close #fileHandle
Next fileHandle
' Fermer le fichier texte
myFile.Close
MsgBox "Création des fichiers " & Format(Timer - t, "0.00 \sec")
End Sub
