Dim Ret As Integer
Function IsFileOpen(filename As String, OK As Boolean As Boolean
' (code Microsoft donné par BrunoM45 (Barbatruc)
' http://support.microsoft.com/default.aspx?scid=kb;EN-US;q138621)
Dim filenum As Integer, errnum As Integer
OK = False
On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open filename For Input Lock Read As #filenum
Close filenum ' Close the file.
errnum = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
' Check to see which error occurred.
Select Case errnum
' No error occurred.
' File is NOT already open by another user.
Case 0
IsFileOpen = False
Ret = 0
' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True
Ret = -1
' Another error occurred, file is being queried.
Case Else
Ret = errnum
End Select
If Ret < 1 Then OK = True
End Function
Sub Arret()
Ret = MsgBox("Erreur (nom du chemin, du fichier...)" & Chr(10) & "Arrêt de la macro", vbOKOnly + vbInformation)
End
End Sub
Sub ImportRupture()
Dim DerLg As Integer
Dim OK As Boolean
Chemin = "C:\Gestion\" '"C:\Gestion\" 'A modifier si nécessaire
On Error Resume Next
If IsFileOpen(Chemin & "Rupture.xls", OK) And OK Then
Windows("Rupture.xls").Activate
GoTo Suite
Else
Arret
End If
If Not IsFileOpen(Chemin & "Rupture.xls", OK) And OK Then
Application.Workbooks.Open Chemin & "Rupture.xls"
Else
Arret
End If
Suite:
----
End Sub