Loop Through Folders/SubFolders

Topic

New Reply

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.

Reply | Quote

Replies

P.P.,

Welcome to the Lounge as a New Poster! :cheers:

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. :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

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

Reply | Quote

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:BEKDocsExcelVBA" '*** 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 :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

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?

Reply | Quote

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

Reply | Quote

P.P.,

Do you want to maintain the folder structure in the destination location or just copy all the files to the same folder? :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Retired Geek: I don’t need to maintain the folder structure in the Destination Folder.

Thanks again for all the help.

Reply | Quote

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:BEKDocsExcel" '*** 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 :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Retired Geek – this looks like it would be perfect for my needs by vba seems to disagree. Screams blue murder at FileCopy strRootDir & strDirName, zDestDir & strDirName with “Run-time error ’75’: Path/File access error. Help doesn’t help because it doesn’t address variables.

Your thoughts?

Thanks.

Reply | Quote

I think this line: FileCopy strRootDir & strDirName, zDestDir & strDirName
Should be: FileCopy zSearchDir & zFound, zDestDir & zFound

cheers, Paul

Reply | Quote

Fabulous! Thanks Paul for your lightening quick response – appreciate it!

Reply | Quote