Results 1 to 2 of 2

Check if Directory is Empty and Provide Message

Threaded View

  1. #1
    Forum Contributor
    Join Date
    11-28-2005
    Location
    Dover, England
    Posts
    172

    Check if Directory is Empty and Provide Message

    I have adapted a wonderful bit of code to fulfil the renaming of my files however, when it runs it crashes if a the directory has nothing in it. Can some one advise/adapt the code to identify the directory is empty, display a message informing me that it is and go back to the browser.

    Thanks

    Sub PopulateDirectoryList()
         'dimension variables
        Dim objFSO As FileSystemObject, objFolder As Folder
        Dim objFile As File, strSourceFolder As String, x As Long, i As Long
        Dim wbNew As Workbook, wsNew As Worksheet
         
        ToggleStuff False 'turn of screenupdating
         
        Set objFSO = New FileSystemObject 'set a new object in memory
        strSourceFolder = BrowseFolder 'call up the browse for folder routine
        If strSourceFolder = "" Then Exit Sub
         
             
        'Clear old data
        
        Call CleanUp
        Kill ("C:\SNDATA\eReport\*.GIF")
    
                 
        Set wbNew = ActiveWorkbook
        Set wsNew = wbNew.Sheets(1) 'set the worksheet
        wsNew.Activate
           
           
           
        With wsNew.Range("A1:B1")
            .Value = Array("File", "Full Path")
            .Interior.ColorIndex = 7
            .Font.Bold = True
            .Font.Size = 12
        End With
           
           
           
        With Application.FileSearch
            .LookIn = strSourceFolder 'look in the folder browsed to
            .FileType = msoFileTypeAllFiles 'get all files
            .SearchSubFolders = True 'search sub directories
            .Execute 'run the search
             
            For x = 1 To .FoundFiles.Count 'for each file found, by the count (or index)
                i = x 'make the variable i = x
                If x > 60000 Then 'if there happens to be more than multipls of 60,000 files, then add a new sheet
                    i = x - 60000 'set i to the right number for row placement below
                    Set wsNew = wbNew.Sheets.Add(after:=Sheets(wsNew.Index))
                    With wsNew.Range("A2:B2")
                        .Value = Array("File", "Size")
                        .Interior.ColorIndex = 7
                        .Font.Bold = True
                        .Font.Size = 12
                    End With
                     
                End If
                On Error GoTo Skip 'in the event of a permissions error
                 
                Set objFile = objFSO.GetFile(.FoundFiles(x)) 'set the object to get it's properties
                With wsNew.Cells(2, 1) 'populate the next row with the variable data
                    .Offset(i, 0) = objFile.Name
                    .Offset(i, 1) = objFile.Path
                     
                End With
                 ' Next objFile
    Skip:
                 'this is in case a Permission denied error comes up or an unforeseen error
                 'Do nothing, just go to next file
            Next x
            wsNew.Columns("A:B").AutoFit
             
        End With
         
         'clear the variables
        Set objFolder = Nothing
        Set objFile = Nothing
        Set objFSO = Nothing
        Set wsNew = Nothing
        Set wbNew = Nothing
         
        ToggleStuff True 'turn events back on
        
    Call DeleteNonPrsParts
    
        Rows("1:1").Select
        Selection.Delete Shift:=xlUp
        Range("A1").Select
    
        Range("A65500").Select
        Selection.End(xlUp).Select
        Range(Selection, Cells(1)).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        Sheets("Sheet4").Select
        Range("A1").Select
        ActiveSheet.Paste
     
        Application.CutCopyMode = False
        Sheets("Sheet3").Select
        
    
    
    End Sub
    Last edited by Tellm; 01-30-2013 at 06:17 AM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1