Access qui plante à l'exécution d'un module code VBA

Bonjour,

j'ai Access 2013 sous Windows 7. Lorsque j'exécute le module 1 de ma base de données, Access plante avec un message d'erreur qui dit Access doit fermer... Or, si la feuille Excel dans lequel le code va chercher des données est ouverte, Access ne plante pas, mais par conséquent n'exécute pas le reste du code; ce qui est normal due à la structure de celui-ci. Je crois donc qu'il y a de quoi dans le code qui fait planter (car j'ai réinstaller Access et essayé la base sur d'autres ordi et ça plante aussi). Pouvez-vous m'aider, je n'arrive pas à pointer le problème. Merci!!

Voici le code :

Option Compare Database
Option Explicit
Sub ImportProjets()
Const cstlngDécalage As Long = -1

Dim rsFeuille As Recordset
Dim rsProjet As Recordset
Dim lngNuméroProjet As Long
Dim lngCompte As Long
Dim lngCompteLigne As Long
If FichierDisponible("G:\SID\BD_2013-07-05\F-1-1 Liste des projets_complete.xlsm") = False Then
Beep
MsgBox "La feuille est ouverte par au moins un utilisateur"
Exit Sub
End If

With CurrentDb
Set rsFeuille = .OpenRecordset("Feuil2")
Set rsProjet = .OpenRecordset("T_Liste")
End With

rsProjet.Index = "idProjet"

BeginTrans

With rsFeuille
Do Until .EOF
lngCompteLigne = lngCompteLigne + 1
lngNuméroProjet = rsFeuille(1 + cstlngDécalage)
With rsProjet
.Seek "=", lngNuméroProjet
If .NoMatch = True Then
lngCompte = lngCompte + 1
.AddNew
!idProjet = lngNuméroProjet
Else
.Edit
End If
![NO DE DOSSIER] = rsFeuille(2 + cstlngDécalage)
!CD = rsFeuille(3 + cstlngDécalage)
![TITRE DES PROJETS] = rsFeuille(4 + cstlngDécalage)
![TITRE ABRÉGÉ DES PROJETS] = rsFeuille(5 + cstlngDécalage)
![DATE D'OUVERTURE] = rsFeuille(6 + cstlngDécalage)
!MotCle01 = rsFeuille(7 + cstlngDécalage)
!MotCle02 = rsFeuille(8 + cstlngDécalage)
!TitreCourt = rsFeuille(9 + cstlngDécalage)
!Discipline = rsFeuille(10 + cstlngDécalage)
!VilleRealisation = rsFeuille(11 + cstlngDécalage)
!Mandat = rsFeuille(12 + cstlngDécalage)
.Update
End With
.MoveNext
Loop
End With

If MsgBox(lngCompte & " nouveau(x) projet(s), les ajouter (Non indiqué, mais peut aussi comprendre des modifications dans les noms)?", vbYesNo) = vbYes Then
CommitTrans
Else
Rollback
End If

End Sub

Function FichierDisponible(prmstrFichier) As Boolean
Dim lngFichier As Long
On Error Resume Next
lngFichier = FreeFile
Open prmstrFichier For Binary Lock Read Write As #lngFichier
If Err.Number Then
FichierDisponible = False
Else
FichierDisponible = True
Close #lngFichier
End If
On Error GoTo 0
End Function