Consulting

Results 1 to 7 of 7

Thread: Check If Files In A Folder Are Open Without Knowing Name/File Type

  1. #1

    Check If Files In A Folder Are Open Without Knowing Name/File Type

    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

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    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
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    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

  4. #4
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    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

  5. #5
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    http://blog.didierstevens.com/2011/0...skmanager-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.
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  6. #6
    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

  7. #7
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •