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

Le
ttcpp
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_ReportingReportingAvifilecopy.avi"
Animation1.Open Nom_Avi1
Animation1.AutoPlay = True

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

Set f = fso.GetFolder("C:DataEssaiSocietes")


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_ReportingReportingTableau de
Bord2008TB" & 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_ReportingReportingTableau de Bord2008TB" & 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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
FFO
Le #17437571
Salut à toi

Ce petit bout de code détecte si un fichier est déjà ouvert (message dans
une boîte de dialogue):

Workbooks.Open ("C:Fichier.xls")
On Error GoTo Ouvert
ActiveWorkbook.Save
ActiveWorkbook.Close
Exit Sub
Ouvert:
MsgBox ("Déjà ouvert")
ActiveWorkbook.Close SaveChanges:úlse

Celà devrait convenir

Dis moi !!!
ttcpp
Le #17444141
"FFO" a écrit :

Salut à toi

Ce petit bout de code détecte si un fichier est déjà ouvert (message dans
une boîte de dialogue):

Workbooks.Open ("C:Fichier.xls")
On Error GoTo Ouvert
ActiveWorkbook.Save
ActiveWorkbook.Close
Exit Sub
Ouvert:
MsgBox ("Déjà ouvert")
ActiveWorkbook.Close SaveChanges:úlse

Celà devrait convenir

Dis moi !!!



Merci pour ta réponse, mais j'ai déjà essayé ce test et c'est trop lent, car je transfert entre 1 et 30 fichiers à la fois et l'accés au disque réseau n'est pas trés rapide. Peut-être y-a-t-il une autre solution ?


Publicité
Poster une réponse
Anonyme