Results 1 to 9 of 9
  1. #1
    New Lounger
    Join Date
    Dec 2014
    Posts
    4
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Loop Through Folders/SubFolders

    Good Evening,

    I am currently using FileSystemObject to copy files from one location and paste to another. All is well. I want to enhance this a little.

    I need to do 2 additional things:

    1. I need to loop through all subFolders of the specified folder
    2. I need to copy ONLY the files that do NOT have a "CDW" or "DWA" prefix in the file name i.e. cdw_1, dwa_1, enh_1, enh_2. The only files copied are the enh_1 and enh_2.

    Can someone point me in the right direction please.

    Thanks in advance.

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,433
    Thanks
    371
    Thanked 1,456 Times in 1,325 Posts
    P.P.,

    Welcome to the Lounge as a New Poster!

    Although you've posted this to the Database forum you don't specify what language you are scripting in? Is it VBA in Access (what version) or VB Script (what OS Version), or other? Please specify and sample code you already have would be useful as a starting point.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  3. #3
    New Lounger
    Join Date
    Dec 2014
    Posts
    4
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Sorry, this is VBA in Access (14 --Access 2010) and the COPY code is below:
    Public Sub CopyMyFiles(str_Path_Cur, str_Path_New As String)
    Dim fso
    Dim ObjFolder
    Dim ObjOutFile
    Dim ObjFiles
    Dim ObjFile
    Const OverwriteExisting = True

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    objFSO.CopyFile str_Path_Cur & "\*.txt", str_Path_New & "\", OverwriteExisting

    '************************************************* ***************************************
    MsgBox "Files Copied"
    '************************************************* ********************************************
    End Sub

  4. #4
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,433
    Thanks
    371
    Thanked 1,456 Times in 1,325 Posts
    P.P.

    I'm not up of the FileSystemObject but here's some code that will do what you want as I understand it.
    Code:
    Sub FilterDirectory()
    
        Dim zSearchDir As String  '*** Directory to Search ***
        Dim zDestDir   As String  '*** Where to copy files ***
        Dim zFound     As String
        Dim lFileCnt   As Long
    
        zSearchDir = "G:\BEKDocs\Excel\VBA\" '*** MUST have trailing \ ***
        zDestDir = "G:\Test\"
       
        zFound = Dir(zSearchDir & "*.*") '*** Get First File ***
        
        Do While zFound <> vbNullString
        
          Select Case Left(zFound, 3)
                Case "CDW"
                Case "DWA"
                Case "VBA"  '*** For my test you can delete ***
                Case Else   '*** Found a file to process    ***
                '  Do your processing here!
                '*** Start Test Code ***
                  Debug.Print zFound
                  lFileCnt = lFileCnt + 1
                '*** End   Test Code ***
                FileCopy zSearchDir & zFound, zDestDir & zFound
          End Select
          
          zFound = Dir()   '*** Get Next File ***
          
        Loop
        
        MsgBox "There were " & Format(lFileCnt) & " files found" & vbCrLf & _
               "matching the criteria and processed.", vbOKOnly + vbInformation, _
               "Process Completed Status:"
               
     End Sub  '*** FilterDirectory() ***
    Of course you can remove the message box and file counter if you don't need that.
    You can also pas in the Search and Destination directories if you wish per your original code.

    HTH
    Last edited by RetiredGeek; 2014-12-30 at 16:50.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  5. #5
    Star Lounger
    Join Date
    Dec 2009
    Location
    Findlay, Ohio
    Posts
    57
    Thanks
    4
    Thanked 6 Times in 6 Posts
    Something like this? Not the cleanest but it works.
    Code:
    Option Explicit 'force all variables to be declared
    dim objFSO,objFolder2,objFile2,Directory,fsodir, sf, fullpath, Filename
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    set fsodir = CreateObject("Scripting.FileSystemObject")
    Directory = fsodir.GetAbsolutePathName(".")
    Directory = "c:\hardwiredpath"
    Set objFolder2 = objFSO.GetFolder(Directory)
    gofish(Directory)
    set objFolder2 = nothing
    Function GoFish(Dir)
    Set objFolder2 = objFSO.GetFolder(Dir)
    For Each objFile2 In objFolder2.Files
        If (InStr(objFile2.Name, ".") > 0) Then
    		fullpath = objFSO.GetAbsolutePathName(objFile2)
    		Filename = objFSO.GetFileName(objFile2)
    		if (lcase(left(Filename,3)) <> "cdw" and lcase(left(Filename,3)) <> "dwa") then
    			wscript.echo fullpath & "\" & Filename
    			' do something with it
    		end if
    	End If
    next
    For Each sf In objFolder2.SubFolders
    	GoFish(sf)  
    Next
    End Function
    Last edited by RetiredGeek; 2014-12-31 at 05:23. Reason: Added Code Tags

  6. #6
    New Lounger
    Join Date
    Dec 2014
    Posts
    4
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Retired Geek:

    I've tested this several times and the Case statement works beautifully and the files are are copied correctly, however the code only searches the specified directory not any of the sub folders. I've tried many things but can't seem to get it to loop through all folders. Any idea on what I need to do from this point?

  7. #7
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,433
    Thanks
    371
    Thanked 1,456 Times in 1,325 Posts
    P.P.,

    Do you want to maintain the folder structure in the destination location or just copy all the files to the same folder?
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  8. #8
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,433
    Thanks
    371
    Thanked 1,456 Times in 1,325 Posts
    P.P.,

    Ok, I borrowed a little code from the internet and integrated my Select statement and added the capability to create directory structure in the destination. This code will allow you to send the files to a single directory or to maintain the directory structure at the destination. You only have to comment/uncomment the code as indicated.

    Code:
     Sub TestFCF()
     
        Dim zSearchDir As String  '*** Directory to Search ***
        Dim zDestDir   As String  '*** Where to copy files ***
        
        zSearchDir = "G:\BEKDocs\Excel\" '*** MUST have trailing \ ***
        zDestDir = "G:\Test\"
        
        '*** Note the file type is OPTIONAL but if used no period and no wildcards!
        
        FilterCopyFiles zSearchDir, zDestDir, "xlsm"
    
     End Sub
    
    Sub FilterCopyFiles(zSearchDir As String, zDestDir As String, Optional zFileType As String)
     
       Dim zFoundItem  As String
       Dim bTypeMatch  As Boolean
       Dim colDirs     As Collection
       Dim lDirCounter As Long
       Dim lFileCnt    As Long
       Dim lIndex      As Long
     
       Set colDirs = New Collection
       colDirs.Add zSearchDir
       lDirCounter = 1
       lIndex = 2
     
    'check for sub directories and make a recursive call to the lowest level dirs first
    
       Do While lDirCounter <= colDirs.Count
         zSearchDir = colDirs(lDirCounter)
         zFoundItem = Dir(zSearchDir, vbDirectory + vbNormal)
    
         Do While zFoundItem <> ""
           If zFoundItem <> "." And zFoundItem <> ".." Then
             If (GetAttr(zSearchDir & zFoundItem) And vbDirectory) = vbDirectory Then
     
               'add to the directories collection so that this will be done later
    
               colDirs.Add zSearchDir & zFoundItem & "\"
               
             Else
     
               'we found a normal file
    
                bTypeMatch = False
    
                If zFileType = "*.*" Then
                  bTypeMatch = True
                ElseIf UCase(Right(zFoundItem, Len(zFileType))) = UCase(zFileType) Then
                      bTypeMatch = True
                End If
    
                If bTypeMatch = True Then
                
                  Select Case Left(zFoundItem, 3)
                        Case "CDW"
                        Case "DWA"
                        Case "VBA"  '*** For my test you can delete ***
                        Case Else   '*** Found a file to process    ***
                        '  Do your processing here!
                        '*** Start Test Code ***
                           Debug.Print zSearchDir & zFoundItem
                           lFileCnt = lFileCnt + 1
                        '*** End   Test Code ***
                        
                        '**** Use ONE of the following - Comment out the other ***
                        
                        'To send files to single directory:
    
    '                     FileCopy strRootDir & strDirName, zDestDir & strDirName
                         
                        'To Maintain Sub-Directory Structure:
                        
                         On Error GoTo TrapErrors
                         FileCopy zSearchDir & zFoundItem, _
                                  zDestDir & Right(zSearchDir, Len(zSearchDir) - Len(colDirs(1))) & "\" & zFoundItem
                         On Error GoTo 0
                         
                  End Select
    
                  lIndex = lIndex + 1
                End If
              End If
           End If
    
           zFoundItem = Dir
    
         Loop   'While zFoundItem
    
         lDirCounter = lDirCounter + 1
    
        Loop    'While lDirCounter
    
        MsgBox "There were " & Format(lFileCnt) & " files found" & vbCrLf & _
               "matching the criteria and processed.", vbOKOnly + vbInformation, _
               "Process Completed Status:"
               
        GoTo GetOut
        
    TrapErrors:
    
      Select Case Err
            Case 76
               '*** Create Directory at Destination Location ***
               MkDir zDestDir & Right(zSearchDir, Len(zSearchDir) - Len(colDirs(1)))
               Resume
            
            Case Else
                MsgBox "Error # " & Err & " : " & Error(Err)
            Exit Sub
    
      End Select
    
    GetOut:
    
    End Sub   'FilterCopyFiles
    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  9. #9
    New Lounger
    Join Date
    Dec 2014
    Posts
    4
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Retired Geek: I don't need to maintain the folder structure in the Destination Folder.

    Thanks again for all the help.

Posting Permissions

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