Erreur 67 VBA
Bonjour,
J'écris ce petit message car je suis bien embêter, j'ai créé un bout de code qui me permet de naviguer dans deux répertoires et dans chacun de ces répertoires parcourir les fichier ".txt" pour y récupérer une ligne de texte.
Le code fonctionne bien, mais le problème auquel je suis confronté c'est que lorsque je lance ma macro, à partir d'un certain temps VBA me retourne :
"Erreur 67: Trop de fichiers"
Il est vrai que je parcours un bon nombre de fichiers mais ils sont réparti dans deux répertoire que je traite l'un après l'autre, de plus j'ai vu sur internet que le soucis pouvait provenir du fait que les fichiers sont ouvert en même temps, or je récupère mes infos dans mes fichiers textes en les ouvrant un à un et en prenant soin de les fermer après avoir récupéré ce qui m’intéressais.
Voici ma macro concernée:
Option Compare Database
Public Tb() As String
Public t As Integer
Sub ReadTxt()
' Lecture de fichier texte écrit avec PRINT
' Utilisation de la commande LINE INPUT qui lit une ligne au complet
Dim i As Long, j As Long, ar
Dim ValCompo, ValProd As String
Dim iFile As Integer
Dim data
Dim InitialDirectory As String
Dim longueur As Integer
Dim deb, debut As String
Dim ValRefProd As String
'Lecture du fichier et ecriture dans BDD
Dim Rep
Dim oFSO, oFic
Dim iFic As Integer
Dim strLigne As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
Rep1 = "T:\ISh\Prg\IS\L1"
Rep2 = "T:\ISh\Prg\IS\L2"
DoCmd.SetWarnings False
CurrentDb.Execute "DELETE * FROM [Communs];"
If oFSO.FolderExists(Rep1) Then
t = 1
For Each oFl In oFSO.GetFolder(Rep1).Files
Fic = Mid(oFl, 18)
If oFl.ShortName Like "*.txt" Then
intFic = FreeFile
Open Rep1 & "\" & Fic For Input As intFic
ValRefProd = Replace(Fic, ".txt", "")
ReDim Preserve Tb(1 To t)
Tb(t) = ValRefProd
Debug.Print Tb(t)
t = t + 1
While Not EOF(intFic)
Line Input #intFic, strLigne
If Mid(strLigne, 190, 3) = "Yes" Then
ValRefAnn = Mid(strLigne, 28, 10)
DoCmd.RunSQL "INSERT INTO COMMUNS (Ref_Produit, Ref_Compo) VALUES ('" & ValRefProd & "', '" & ValRefAnn & "')"
'Debug.Print ValRefProd & "//" & ValRefAnn
End If
Wend
Close intFic
End If
Next
End If
If oFSO.FolderExists(Rep2) Then
For Each oFl In oFSO.GetFolder(Rep2).Files
Fic = Mid(oFl, 18)
If oFl.ShortName Like "*.txt" Then
intFic = FreeFile
Open Rep2 & "\" & Fic For Input As intFic
ValRefProd = Replace(Fic, ".txt", "")
If BoucleSurTabl(ValRefProd, Tb) = False Then GoTo Line1 Else GoTo Line2
Line1:
While Not EOF(intFic)
Line Input #intFic, strLigne
If Mid(strLigne, 190, 3) = "Yes" Then
ValRefAnn = Mid(strLigne, 28, 10)
DoCmd.RunSQL "INSERT INTO COMMUNS (Ref_Produit, Ref_Compo) VALUES ('" & ValRefProd & "', '" & ValRefAnn & "')"
'Debug.Print ValRefProd & "//" & ValRefAnn
End If
Wend
Close intFic
Line2:
End If
Next
End If
DoCmd.SetWarnings True
'Fermer le fichier
Close #iFile
End Sub
'Cette fonction permet de chercher dans un tableau si le produit recherché est présent
Function BoucleSurTabl(chaine As String, Tb) As Boolean
BoucleSurTabl = False
For j = LBound(Tb) To UBound(Tb)
If Tb(j) = chaine Then BoucleSurTabl = True: Exit Function
Next
End Function
PS: Je sais bien que c'est du "Access" et que l'on est sur un forum Excel mais je suis tellement bloqué que..
Bonjour Iliasse
Comme ça le code me parait OK,
mais comme tu le dis si bien, c'est du ACCESS cela n'a rien à faire ici surtout que nous n'avons pas ta Base pour tester
Il existe un tas de forums pour Access, notamment sur Développez.com
Oui désolé, je sais que le message n'est pas à sa place. Mais sur ce forum les internautes sont super compétent et je me disais qu'ils pourraient m'aider à comprendre où ça cloche.