tester si un fichier est déja ouvert par un autre utilisateur

Bonjour,

Je génére un cerains nombre de fichiers excel sur mon disque local. Je dois
ensuite les transférer sur le disque réseau. J'ai donc créer une macro qui me
déplace les fichiers à l'endroit voulu et cela fonctionne trés bien.
Par contre si un utilisateur X a ouvert un fichier que je veux remplacé
celui-ci n'est pas mis à jour et je n'ai pas de message d'erreur. J'ai donc
voulu créér un code pour tester si le fichier est ouvert par quelqu'un avant
de le copier.
Mais cela ne fonctionne pas bien, en effet même si le fichier n'est pas
ouvert j'ai quand même une message me disant que c'est moi qui l'ai ouvert.
Pour info mes fichiers xls sont en mode partagé, pour voir qui est
l'utilisaeur du fichier.

Voici le code que j'ai utilisé :


Public fl As File
Public Nom_Fichier As String
Public Nom_Rep_Source As String
Public Nom_Rep_Dest As String
Public TestError As Integer

Private Sub Lancement_Copie_Click()

Dim fso As FileSystemObject
Dim f, f1, f2 As Folder
Dim fc, fc1, fc2 As Files
Dim s As String
Dim n As Integer
Dim i As Integer

Dim Nom_Avi1 As String

Animation1.AutoPlay = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Nom_Avi1 = "H:\DF_Reporting\Reporting\Avi\filecopy.avi"
Animation1.Open Nom_Avi1
Animation1.AutoPlay = True

ProgressBar1.MAX = 1
Set fso = CreateObject("Scripting.FileSystemObject")

Set f = fso.GetFolder("C:\Data\Essai\Societes\")


ProgressBar1.Min = 0
n = f.Files.Count + f1.Files.Count + f2.Files.Count
ProgressBar1.MAX = n
i = 1
On Error GoTo GestErreur
Nom_Rep_Dest = Tbox_Nom_Rep_Dest.Value
'Copie des fichiers du répertoire Société
For Each fl In fc
If fl.Type = "Feuille de calcul Microsoft Excel" Then
On Error Resume Next
'Name fl.Name As fl.Name
TestFichierEstOuvert fl.Name
If TestError = 0 Then
Call fso.CopyFile(fl, "H:\DF_Reporting\Reporting\Tableau de
Bord\2008\TB\" & Nom_Rep_Dest & "\", True)
tbox_Nom_Fichier.Value = fl.Name
Animation1.SetFocus
DoEvents
Call fso.DeleteFile(fl)
End If
End If
ProgressBar1.Value = i
i = i + 1
Next


'Destroy All Objects
Set fc = Nothing
Set f = Nothing
Set fso = Nothing
Set fl = Nothing

Animation1.AutoPlay = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Unload Application_Copie_Fichier_TB
GestErreur:
MsgBox fl.Name & " déjà ouvert"

End Sub


Sub TestFichierEstOuvert(fl As String)
Dim Chemin, fichier As String
Dim Utilisateurs
Dim n As Integer

Chemin = "H:\DF_Reporting\Reporting\Tableau de Bord\2008\TB\" & Nom_Rep_Dest
& "\"
fichier = fl
'Workbooks.Open (Chemin & fichier)
'MsgBox ActiveWorkbook.MultiUserEditing
Utilisateurs = ActiveWorkbook.UserStatus
For n = 1 To UBound(Utilisateurs, 1)
MsgBox fichier & " est utilisé par " & Utilisateurs(n, 1) 'affichage du
nom des noms pc
Next
If n >= 1 Then TestError = 1
End Sub


Merci pour votre aide