Find a Folder on A Drive 2

[robcarr]

Dear All,

What I would like to do is find multiple folders named December on a Drive and if it finds the folders create another folder in the same place called January, December can be in multiple places, is this possible and has anyone done this before, if so, can you let me know. Other than that is there a way to list all paths were december is in the path somewhere and store in a spreadsheet, December is normally the last folder on a path. (for example H:\reports\daily\December),

Any help on this would be greatly appreciated, I know how to create a folder for a new month, but the company I work for always change folders and locations, so I was hoping to do a kind of find and create a new folder search on a drive.

Thanks in advnce for any help on this.

 

[Zathras]

Here is an old trick from an old programmer:

Open a DOS window and run the following command (assuming that you are searching driver "H":

dir H:\december /ad/s | find "december"/i >c:\december.txt

Then process the resulting file c:\december.text

The thing following the /s is the "split vertical bar" character usually located as a shift character on the keyboard. It indicates that the output from the dir command is to be piped as input into the find command.

If you don't have a DOS manual handy, you can enter

dir /?

and

find /?

to get a display of the parameter usage.

Hope this helps.

 

[sfvb]

Here's another way:

Sub UpdateDecember()
   ' Add reference to Microsoft Scripting Runtime before running this code
   Dim fso                 As FileSystemObject
   Dim drvCollection       As Drives
   Dim drv                 As Drive
   Dim fld                 As Folder

   Set fso = CreateObject("Scripting.FileSystemObject")

   Set drvCollection = fso.Drives
   For Each drv In drvCollection
      If drv.drivetype = Fixed Then    'Or drv.DriveType = Remote Then
         Set fld = fso.GetFolder(drv.DriveLetter & ":\")
         Call FindSubFolder(fso, fld)
     End If
   Next
End Sub

Private Sub FindSubFolder(fso, fld)
   Dim fldCollection       As Folders
   Dim subFld              As Folder
   Dim createdFld          As Folder
   
   Set fldCollection = fld.SubFolders
   If fldCollection.Count <> 0 Then
      For Each subFld In fldCollection
         If UCase(subFld.Name) = &quot;DECEMBER&quot; Then
            If Right(subFld.ParentFolder, 1) = &quot;\&quot; Then
               If fso.FolderExists(subFld.ParentFolder & &quot;January&quot;) = False Then
                  Set createdFld = fso.CreateFolder(subFld.ParentFolder & &quot;January&quot;)
               End If
            Else
               If fso.FolderExists(subFld.ParentFolder & &quot;\January&quot;) = False Then
                  Set createdFld = fso.CreateFolder(subFld.ParentFolder & &quot;\January&quot;)
               End If
            End If
         End If
         Call FindSubFolder(fso, subFld)  'This is a recursive Call
      Next
   End If
End Sub

 

[robcarr]

sfvb,

Thanks for the responses on this. it seems like it will work, a question though, will it work on a network drive, I only want to check 1 drive, we have currently 8 drives setup and I don't want to alter any other drives other than the 1 require.

I thought I could change it in

Set drvCollection = fso.Drives

and change fso.drives to the drive I want but all I got was error maessages, any further help will be extremely welcome.

Thanks.

 

[sfvb]

To use only one drive (drive E in this example), change the Update Decemeber routine to:

Sub UpdateDecember()
   ' Add reference to Microsoft Scripting Runtime before running this code
   Dim fso                 As FileSystemObject
   Dim drvCollection       As Drives
   Dim drv                 As Drive
   Dim fld                 As Folder

   Set fso = CreateObject("Scripting.FileSystemObject")

'   Set drvCollection = fso.Drives
'   For Each drv In drvCollection
'      If drv.drivetype = Fixed Then    'Or drv.DriveType = Remote Then
         Set fld = fso.GetFolder("

E:\

")
         Call FindSubFolder(fso, fld)
'     End If
'   Next
End Sub

OR

Sub UpdateDecember()
   ' Add reference to Microsoft Scripting Runtime before running this code
   Dim fso                 As FileSystemObject
   Dim drvCollection       As Drives
   Dim drv                 As Drive
   Dim fld                 As Folder

   Set fso = CreateObject("Scripting.FileSystemObject")

   Set drvCollection = fso.Drives
   For Each drv In drvCollection
      If drv.drivetype = Fixed Then    'Or drv.DriveType = Remote Then

If drv.DriveLetter = "E" Then

            Set fld = fso.GetFolder(drv.DriveLetter & ":\")
            Call FindSubFolder(fso, fld)

End If

     End If
   Next
End Sub

Here's a link to the FileSystemObject, in case you want to look at what's possible with it.

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/jsobjfilesystem.asp

 

[robcarr]

Dear All,

I have tried to use the coding above to create folders and it isnt working, it cant find any folders named as March, I have approx 20 folders in this one area all named as March and not one is found.
Sub Create_Folders()
' Add reference to Microsoft Scripting Runtime before running this code
Dim fso As FileSystemObject
Dim drvCollection As Drives
Dim drv As Drive
Dim fld As Folder

Set fso = CreateObject("Scripting.FileSystemObject&quot

Set drvCollection = fso.Drives
For Each drv In drvCollection
If drv.DriveType = Fixed Then 'Or drv.DriveType = Remote Then
Set fld = fso.GetFolder("M:\Management\Reports&quot
Call FindSubFolder(fso, fld)
End If
Next
Mainform.Show
End Sub
Private Sub FindSubFolder(fso, fld)
Dim fldCollection As Folders
Dim subFld As Folder
Dim createdFld As Folder
Set fldCollection = fld.SubFolders
If fldCollection.Count <> 0 Then
For Each subFld In fldCollection
If UCase(subFld.Name) = &quot;March&quot; Then
If Right(subFld.ParentFolder, 1) = &quot;\&quot; Then
If fso.FolderExists(subFld.ParentFolder & &quot;April&quot = False Then
Set createdFld = fso.CreateFolder(subFld.ParentFolder & &quot;April&quot
End If
Else
If fso.FolderExists(subFld.ParentFolder & &quot;\April&quot = False Then
Set createdFld = fso.CreateFolder(subFld.ParentFolder & &quot;\April&quot
End If
End If
End If
Call FindSubFolder(fso, subFld) 'This is a recursive Call
Next
End If
End Sub

This is the coding I have been using.

Any suggestions why it wont work.

Thanks Thanks Rob.

 

[Zathras]

try changing

If UCase(subFld.Name) = "March" Then

to

If UCase(subFld.Name) = "

MARCH

" Then