PDA

View Full Version : Check If Files In A Folder Are Open Without Knowing Name/File Type



dodonohoe
04-08-2014, 01:01 AM
I have the following code that successfully copies a folder from one location to another. Before it does the copy I would like to know if any of the files within the folder and its sub folders are open. The issue is I don't know what the names of the files will be and also they can be in any format i.e. Excel, CSV, Text PDF etc.

Question Summary: Can I check the contents of the source folder to check if any of the files contained within are open?



Sub Move_Rename_Folder()
'This example move the folder from FromPath to ToPath.

Sheets("Variables").Select

Dim fso As Object
Dim FromPath As String
Dim ToPath As String




FromPath = Range("b22")
ToPath = Range("b24")

'Note: It is not possible to use a folder that exists in ToPath


If Right(FromPath, 1) = "\" Then
FromPath = Left(FromPath, Len(FromPath) - 1)
End If


If Right(ToPath, 1) = "\" Then
ToPath = Left(ToPath, Len(ToPath) - 1)
End If


Set fso = CreateObject("scripting.filesystemobject")


If fso.folderexists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If


If fso.folderexists(ToPath) = True Then
MsgBox ToPath & " exists already, not possible to move to a existing folder"
Exit Sub
End If


fso.CopyFolder Source:=FromPath, Destination:=ToPath
MsgBox "The folder is moved from " & FromPath & " to " & ToPath


End Sub




Thanks,

Des

Bob Phillips
04-08-2014, 02:42 AM
Sub Move_Rename_Folder()
'This example move the folder from FromPath to ToPath.
Dim fso As Object
Dim FromPath As String
Dim ToPath As String

With Worksheets("Variables")

FromPath = .Range("B22")
ToPath = .Range("B24")

'Note: It is not possible to use a folder that exists in ToPath

If Right(FromPath, 1) = "\" Then FromPath = Left(FromPath, Len(FromPath) - 1)

If Right(ToPath, 1) = "\" Then ToPath = Left(ToPath, Len(ToPath) - 1)

Set fso = CreateObject("Scripting.FilesystemObject")

If fso.folderexists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"

ElseIf fso.folderexists(ToPath) = True Then
MsgBox ToPath & " exists already, not possible to move to a existing folder"

Else

Call CheckIfOpen(FromPath)
fso.CopyFolder Source:=FromPath, Destination:=ToPath
MsgBox "The folder is moved from " & FromPath & " to " & ToPath
End If
End With
End Sub

Private Sub CheckIfOpen(ByVal FolderToCheck As String)
Dim wb As Workbook
Dim filename As String
Dim msg As String

filename = Dir(FolderToCheck & Application.PathSeparator & "*.xls*")
Do While Not filename = ""

Set wb = Nothing
On Error Resume Next
Set wb = Workbooks(filename)
On Error GoTo 0
If Not wb Is Nothing Then msg = msg & vbTab & filename & vbNewLine
filename = Dir()
Loop

If Not msg = "" Then

MsgBox "Thes files are open: " & vbNewLine & msg
End If
End Sub

dodonohoe
04-08-2014, 06:29 AM
HI XLD, thanks for the prompt reply. Your solution works if the files open are of type xls. I had hoped changing your code from "*.xls*" to "*.*" might get it to look for files of all extension types but no luck. The other issue is that the code wont look for open files in the subfolders of the main folder we are looking at. Any thoughts on these two remaining issues would be appreciated.

Thanks,

Des

Kenneth Hobs
04-08-2014, 07:11 AM
Some of this may help. The LastUser is specific to just some Excel versions.


'===========================================
'http://www.xcelfiles.com/IsFileOpenAPI.htm
'===========================================

'// Note we use an Alias here as using the Actual
'// function name will not be accepted! ie underscore= "_lopen"


Public myDir As String
Public StartLine As Long
Public HowManyLines As Long
Public myFile
Public i
Public adate
Public ws
Public ActWork
Public NewWrkBk


Private Declare Function lOpen _
Lib "kernel32" _
Alias "_lopen" ( _
ByVal lpPathName As String, _
ByVal iReadWrite As Long) _
As Long


Private Declare Function lClose _
Lib "kernel32" _
Alias "_lclose" ( _
ByVal hFile As Long) _
As Long


'// Don't use these...here for Info only
Private Const OF_SHARE_COMPAT = &H0
Private Const OF_SHARE_DENY_NONE = &H40
Private Const OF_SHARE_DENY_READ = &H30
Private Const OF_SHARE_DENY_WRITE = &H20
'// Use the Constant below
'// OF_SHARE_EXCLUSIVE = &H10
'// OPENS the FILE in EXCLUSIVE mode,
'// denying other processes AND the current process both read and write
'// access to the file. If the file has been opened in any other mode for read or
'// write access _lopen fails. This is important as if you open the file in the
'// current process = Excel BUT loose its handle
'// then you CANNOT open it again in the SAME session!
Private Const OF_SHARE_EXCLUSIVE = &H10


Sub test_IsFileAlreadyOpen()
Dim tf As Boolean
tf = IsFileAlreadyOpen("C:\myfiles\wp\isexerunning.wcm")
MsgBox tf
If tf Then MsgBox (LastUserWP("C:\myfiles\wp\isexerunning.wcm"))
End Sub


'If the Function succeeds, the return value is a File handle.
'If the Function fails, the return value is HFILE_ERROR = -1
Function IsFileAlreadyOpen(strFullPath_FileName As String) As Boolean
'// Ivan F Moala
'// http://www.xcelfiles.com
Dim hdlFile As Long
Dim lastErr As Long

hdlFile = -1

'// Open file for Read/Write and Exclusive Sharing.
hdlFile = lOpen(strFullPath_FileName, OF_SHARE_EXCLUSIVE)
'// If we can't open the file, get the last error.
If hdlFile = -1 Then
lastErr = Err.LastDllError
Else
'// Make sure we close the file on success!
lClose (hdlFile)
End If

'// Check for sharing violation error.
IsFileAlreadyOpen = (hdlFile = -1) And (lastErr = 32)

End Function

Function LastUser(strPath As String) As String
'// Code by Helen from http://www.visualbasicforum.com/index.php?s=
'// This routine gets the Username of the File In Use
'// Credit goes to Helen for code & Mark for the idea
'// Insomniac for xl97 inStrRev
'// Amendment 25th June 2004 by IFM
'// : Name changes will show old setting
'// : you need to get the Len of the Name stored just before
'// : the double Padded Nullstrings
Dim strXl As String
Dim strFlag1 As String, strflag2 As String
Dim i As Integer, j As Integer
Dim hdlFile As Long
Dim lNameLen As Byte


strFlag1 = Chr(0) & Chr(0)
strflag2 = Chr(32) & Chr(32)

hdlFile = FreeFile
Open strPath For Binary As #hdlFile

strXl = Space(LOF(hdlFile))

Get 1, , strXl
Close #hdlFile

j = InStr(1, strXl, strflag2)

#If Not VBA6 Then
'// Xl97
For i = j - 1 To 1 Step -1
If Mid(strXl, i, 1) = Chr(0) Then Exit For
Next
i = i + 1
#Else
'// Xl2000+
i = InStrRev(strXl, strFlag1, j) + Len(strFlag1)
#End If

'// IFM

lNameLen = Asc(Mid(strXl, i - 3, 1))
LastUser = Mid(strXl, i, lNameLen)
End Function

mancubus
04-08-2014, 08:16 AM
http://blog.didierstevens.com/2011/02/03/taskmanager-xls/

download the file here.

populate an array with the applications you want to terminate.

include within your script;
- click List processes button (*)
- insert "t" in column A for applications you want to terminate (you can loop array elements)
- click Execute commands button (*)

(*): run their "button_click" event code. google how to do it.

dodonohoe
04-09-2014, 02:29 AM
Hi Guys, Thanks for all your replies. If I can't do this within VB then I am going to do the following. If the macro throws an error when trying to copy a folder and its sub folders (due to a file being open), I will handle the error and delete any partial folders that have been copied. I will then display a warning message to the user stating that the procedure has been aborted and to check if some of the relevant files are open. Just to be clear, XLD's code above works perfectly if you just have one folder (no sub folders). If anyone has any thoughts on my strategy here, please let me know.

Thanks

Kenneth Hobs
04-09-2014, 05:56 AM
It is simple enough. Just use the IsFileAlreadyOpen() for each file.

One of the easier methods to get subfolder filenames is the fso method SearchFiles() that I posted. http://www.vbaexpress.com/forum/showthread.php?49366

To do your additional item to not copy a subfolder if a file is already open requires more effort. You would need to get all the subfolders and then iterate each rather than getting all the files initially.

There are methods to copy the files and not get a notice if they are locked and did not copy but may well copy but not the latest update obviously. The DOS method XCOPY is what I would use in that case.

You could iterate the files as I explained and log the ones that would not be copied and copy the others.