bonjour
afin de vérifier l'ouverture simultanée d'un fichier en réseau j'utilise ce code qui, à priori doit fonctionner, mais le soucis est qu'il affiche en permanence un second fichier ouvert, ce qui n'est pas le cas lors de mes essais, et qui de plus donne la possibilité d'ouvrir quand même le fichier une seconde fois
l'un de vous pourrait il modifier ce code pour qu'il agisse réellement sur ce qu'on lui demande ?
Merci de votre aide
kinel
Sub TestOuverture()
'test si C2 est ouvert
'si non , arrete le test et continue la macro
'si oui, affiche msg box qui propose de reessayer en recommençant le test
Dim chemintest As String
1: chemintest = ThisWorkbook.Path
If IsFileOpen(chemintest & "\C2.xls") Then
retour = MsgBox("la base est déja ouverte. Cliquez sur le bouton Ok pour réessayer!", vbOKCancel)
If retour = vbOK Then
Application.StatusBar = "Merci de patienter"
Application.Wait Now + TimeValue("00:00:05")
Application.StatusBar = False
GoTo 1:
Else
Exit Sub
End If
End If
End Sub
Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next
filenum = FreeFile()
Open filename For Input Lock Read As #filenum
Close filenum
errnum = Err
On Error GoTo 0
Select Case errnum
Case 0
IsFileOpen = False
Case 70
IsFileOpen = True
Case Else
Error errnum
End Select
End Function
afin de vérifier l'ouverture simultanée d'un fichier en réseau j'utilise ce code qui, à priori doit fonctionner, mais le soucis est qu'il affiche en permanence un second fichier ouvert, ce qui n'est pas le cas lors de mes essais, et qui de plus donne la possibilité d'ouvrir quand même le fichier une seconde fois
l'un de vous pourrait il modifier ce code pour qu'il agisse réellement sur ce qu'on lui demande ?
Merci de votre aide
kinel
Sub TestOuverture()
'test si C2 est ouvert
'si non , arrete le test et continue la macro
'si oui, affiche msg box qui propose de reessayer en recommençant le test
Dim chemintest As String
1: chemintest = ThisWorkbook.Path
If IsFileOpen(chemintest & "\C2.xls") Then
retour = MsgBox("la base est déja ouverte. Cliquez sur le bouton Ok pour réessayer!", vbOKCancel)
If retour = vbOK Then
Application.StatusBar = "Merci de patienter"
Application.Wait Now + TimeValue("00:00:05")
Application.StatusBar = False
GoTo 1:
Else
Exit Sub
End If
End If
End Sub
Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next
filenum = FreeFile()
Open filename For Input Lock Read As #filenum
Close filenum
errnum = Err
On Error GoTo 0
Select Case errnum
Case 0
IsFileOpen = False
Case 70
IsFileOpen = True
Case Else
Error errnum
End Select
End Function