choupi_nette
XLDnaute Occasionnel
Bonjour le forum,
Dans un des codes que j'utilise, j'ai cette fonction qui verifie si un fichier est ouvert avant de commencer le script.
Mais le code renvoie toujours : "le fichier est ouvert" et j'ai l'impression que le fichier meme qui contient la macro (qui doit etre dans le meme dossier que les fichiers à classer) "se voit" ouvert et donc renvoie ce message.
Merci pour votre aide.
Voici le code
Dans un des codes que j'utilise, j'ai cette fonction qui verifie si un fichier est ouvert avant de commencer le script.
Mais le code renvoie toujours : "le fichier est ouvert" et j'ai l'impression que le fichier meme qui contient la macro (qui doit etre dans le meme dossier que les fichiers à classer) "se voit" ouvert et donc renvoie ce message.
Merci pour votre aide.
Voici le code
Code:
Sub testmacro()
Dim objFile1 As file
Dim objFile2 As file
Dim objFolder As Folder
Dim objFSO As FileSystemObject
Set objFSO = New FileSystemObject
Set objFolder = objFSO.GetFolder(ThisWorkbook.Path)
Dim leng As Integer
Dim newFoldName As String
Dim Fname As String
Dim fold As Boolean
fold = False
For Each objFile1 In objFolder.Files
If IsFileOpen(objFile1.Path) Then Call MsgBox("One file is already open. Please make sure all files are closed and try again.", vbInformation): Exit Sub
Next
For Each objFile1 In objFolder.Files
Fname = objFile1.Name
leng = Len(Fname)
If InStr(Fname, ".csv") Or InStr(Fname, ".xad") Then
Call MsgBox(Fname)
If InStr(Fname, "_Results.csv") Then
Fname = Mid(Fname, 1, leng - 12)
Else
Fname = Mid(Fname, 1, leng - 4)
End If
For Each objFile2 In objFolder.Files
If InStr(objFile2.Name, Fname) And Not (objFile1.Name = objFile2.Name) Then
If Not fold Then MkDir (ThisWorkbook.Path & "\" & Fname): fold = True
objFile1.Move (ThisWorkbook.Path & "\" & Fname & "\")
objFile2.Move (ThisWorkbook.Path & "\" & Fname & "\")
End If
Next
fold = False
End If
Next
End Sub
Function IsFileOpen(filename As String) As Boolean
Dim filenum As Integer, errnum As Integer
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
' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
Error errnum
End Select
End Function