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.

Rechercher des sujets similaires à "erreur vba"