Compilation qui ne se termine pas

Bonjour,

J'ai développer un code qui me permet de récupérer des informations contenues dans des fichiers textes. Ces fichiers textes sont contenus dans deux répertoires. Le programme récupère les données dont il a besoin et les écrit dans la base.

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 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

Le problème est que VBA n'arrive jamais à exécuter la totalité de mon code, autrement dit, il parcours le début de mon premier répertoire puis ensuite il plante " Virtual....(ne répond pas)". Avant j'arrivais à l’exécuter normalement, ce problème est apparu depuis peu, sans raison valable à ma connaissance...