VBA to create a list of files in a directory.

[superfb]

Hi

I'm looking for a VBA code to create subfolders.

Ideally the code should pick up the file location from a cell (as there will be multiple users with different gile dirctory saved) and then I have a list in column A of file names that I would like to create folders and at the end the message box says telling me the number of folders created in the name directory.....

 

[Logit]

.
This macro will create folders from list in Col A, placing them into the desktop folder "Test".

Option Explicit


Sub MakeFolders()
    Dim xdir As String
    Dim fso
    Dim lstrow As Long
    Dim i As Long
    Set fso = CreateObject("Scripting.FileSystemObject")
    lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 2 To lstrow '<-- reads list from A2
        'change the path on the next line where you want to create the folders
        xdir = "C:\Users\My\Desktop\Test\" & Range("A" & i).Value
        If Not fso.FolderExists(xdir) Then
            fso.CreateFolder (xdir)
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox i - 2 & " folders created in Directory : C:\Users\My\Desktop\Test\"
End Sub

This should get you started.

 

[superfb]

Thank you for this. But instead of having a file path in the code. Preferably would like the file name coming from a cell....like cell c4?

Also In the code could you very kindly have a line explaining what each code line does. It would be really useful for me to learn. Did you chose the names fso randomly?

 

[Logit]

.

Option Explicit


Sub MakeFolders()
    Dim xdir As String
    Dim fso
    Dim destfol As String
    Dim lstrow As Long
    Dim i As Long
    destfol = Range("C4").Value
    Set fso = CreateObject("Scripting.FileSystemObject")
    lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 2 To lstrow '<-- reads list from A2
        'change the path on the next line where you want to create the folders
        xdir = Range("C4").Value & Range("A" & i).Value
        If Not fso.FolderExists(xdir) Then
            fso.CreateFolder (xdir)
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox i - 2 & " folders created in Directory : C:\Users\My\Desktop\Test\"
End Sub

Note: Using the path example from the last post, in C4 you would enter : C:\Users\My\Desktop\Test\

No quote marks ... and be certain there is a forward slash at the end so the newly created folders will be placed within the folder Test.

 

[Logit]

Option Explicit


Sub MakeFolders()
    Dim xdir        As String   'give the directory a variable (xdir) and DIM it as String
    Dim fso         As Object   'DIM fso as a variable representing the FileSystemObject
    Dim destfol     As String   'DIM destfol (destination folder) as String
    Dim lstrow      As Variant  'DIM lstrow (last row) as Variant. Not certain how many rows will have data in Col A
                                'The total number will vary from time to time
    Dim i           As Long     'DIM the integer "i" as Long to accommodate an large number
    
    Set fso = CreateObject("Scripting.FileSystemObject")    'FileSystemObject allows creation of folders.


    destfol = Range("C4").Value 'destFol is the path entered in cell C4
    lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row   'Finds last used row in Col A
    
    Application.ScreenUpdating = False  'Turn off ScreenUpdating. Makes things run faster.
    
    For i = 2 To lstrow         '<-- reads list beginning from A2
    
        'Range("C4").Value tells Excel what the path is .. Range("A" & i).Value tells Excel to use the folder name
        'from each cell in Col A with a name
        xdir = Range("C4").Value & Range("A" & i).Value
        
        If Not fso.FolderExists(xdir) Then  'If the folder doesn't already exist then
            fso.CreateFolder (xdir)         'Using the FileSystemObject, create the folder named in xdir
        End If
    Next                        'Began at row 2, now go to row 3 and repeat / row 4 and repeat, etc. until end of list Col A
    
    Application.ScreenUpdating = True   'Turn ScreenUpdating back on to show all the changes created
    
    MsgBox i - 2 & " folders created in Directory : C:\Users\My\Desktop\Test\"  'Display MsgBox showing how many
    'folder were created and in what Folder they were created.
   
End Sub

 

[superfb]

Thanks thats awesome and super helpful!!!!!!!

however, i require another macro that can do the following

1) Grab File names
2) Change the file names
3) Move from one directory to specific directory i specify
4) Also could tthere be another macro that grabs all the file names and what files are in there? so i can use this as a means to double check everything has moved over?


[TABLE="width: 637"]
<tbody>[TR]
[TD]File Name[/TD]
[TD]New file name[/TD]
[TD]Create Folder[/TD]
[TD]Move from[/TD]
[TD]Move to[/TD]
[/TR]
[TR]
[TD]ScreenShot.xls[/TD]
[TD]Financial.xls[/TD]
[TD="align: right"]20080816[/TD]
[TD]c:\desktop\test[/TD]
[TD]c:\Financials\test\20080816[/TD]
[/TR]
[TR]
[TD]Test.pdf[/TD]
[TD]Planning.doc[/TD]
[TD="align: right"]20160416[/TD]
[TD]c:\desktop\test[/TD]
[TD]c:\Financials\test\20160416[/TD]
[/TR]
</tbody>[/TABLE]


The problem i have is that i could have multiple file names the same even though they need to go in different folders.....

also the folders i want to create could have the same date names..............

 

[superfb]

Option Explicit




Sub MakeFolders()
    Dim xdir        As String   'give the directory a variable (xdir) and DIM it as String
    Dim fso         As Object   'DIM fso as a variable representing the FileSystemObject
    Dim destfol     As String   'DIM destfol (destination folder) as String
    Dim lstrow      As Variant  'DIM lstrow (last row) as Variant. Not certain how many rows will have data in Col A
                                'The total number will vary from time to time
    Dim i           As Long     'DIM the integer "i" as Long to accommodate an large number
    
    Set fso = CreateObject("Scripting.FileSystemObject")    'FileSystemObject allows creation of folders.


    destfol = Range("C4").Value 'destFol is the path entered in cell C4
    lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row   'Finds last used row in Col A
    
    Application.ScreenUpdating = False  'Turn off ScreenUpdating. Makes things run faster.
    
    For i = 2 To lstrow         '<-- reads list beginning from A2
    
        'Range("C4").Value tells Excel what the path is .. Range("A" & i).Value tells Excel to use the folder name
        'from each cell in Col A with a name
        xdir = Range("C4").Value & Range("A" & i).Value
        
        If Not fso.FolderExists(xdir) Then  'If the folder doesn't already exist then
            fso.CreateFolder (xdir)         'Using the FileSystemObject, create the folder named in xdir
        End If
    Next                        'Began at row 2, now go to row 3 and repeat / row 4 and repeat, etc. until end of list Col A
    
    Application.ScreenUpdating = True   'Turn ScreenUpdating back on to show all the changes created
    
    MsgBox i - 2 & " folders created in Directory : C:\Users\My\Desktop\Test\"  'Display MsgBox showing how many
    'folder were created and in what Folder they were created.
   
End Sub

If Not fso.FolderExists(xdir) Then 'If the folder doesn't already exist then
fso.CreateFolder (xdir)

This bit causes an error.....