Setup of new folders

Barefoot

Board Regular
Joined
Sep 20, 2005
Messages
87
Hi there

Need some help please on a time saving exercise.

What I would like is a routine that will create new (sub?) folders for each month or period for me in a specified/selected folder.
The new folders to be created are either monthly (1 - Apr 0x to 12 - Mar 0x), or by period (Period 1 to Period 12).

You probably noticed, but our financial year runs April to March and I hope to be able to use this routine to setup all the new years folders.

I assume that this would run from excel.

Thanks
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,306
Office Version
  1. 2016
Platform
  1. Windows
How about this ?

Code:
Option Explicit

Private Sub CreateSubfolders(strParentFolder As String, ParamArray SubFolders() As Variant)

    Dim sSubFolderPathName As String, vSubFolder As Variant
    
    If Right(strParentFolder, 1) <> "\" Then
        strParentFolder = strParentFolder & "\"
    End If
    For Each vSubFolder In SubFolders
        sSubFolderPathName = strParentFolder & vSubFolder
        VBA.MkDir (sSubFolderPathName)
    Next

End Sub


Sub test()

    CreateSubfolders "C:\", "Period1", "Period2", "Period3"  '...ect

End Sub

Regards.
 

Barefoot

Board Regular
Joined
Sep 20, 2005
Messages
87
Hi Jaafar

Thanks for that it works well.

Is there a method? that you could use to select the folder to add the new folders to?

Cheers
Julian
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,306
Office Version
  1. 2016
Platform
  1. Windows
Is this what you need ?

Code:
Option Explicit

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Private Type BROWSEINFO
    HwndOwner As Long
    PidlRoot As Long
    PszDisplayName As String
    LpszTitle As String
    UlFlags As Long
    Lpfn As Long
    lParam As Long
    IImage As Long
End Type

Private Function GetFolder() As String

    Dim Info As BROWSEINFO
    Dim lPID As Long, sPath As String
    Dim sFolderPath As String
    Const BIF_RETURNONLYFSDIRS = &H1
    
    Info.LpszTitle = "Select Folder:"
    Info.UlFlags = BIF_RETURNONLYFSDIRS
    lPID = SHBrowseForFolder(Info)
    sPath = Space$(512)
    If (SHGetPathFromIDList(lPID, sPath)) Then
        sFolderPath = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
        GetFolder = sFolderPath
    End If
    
End Function

Private Sub CreateSubfolders(strParentFolder As String, ParamArray SubFolders() As Variant)

    Dim sSubFolderPathName As String, vSubFolder As Variant
    
    If Right(strParentFolder, 1) <> "\" Then
        strParentFolder = strParentFolder & "\"
    End If
    For Each vSubFolder In SubFolders
        sSubFolderPathName = strParentFolder & vSubFolder
        VBA.MkDir (sSubFolderPathName)
    Next

End Sub


Run this routine :


Code:
Sub test()

    Dim sParentFolder As String
    
    sParentFolder = GetFolder
    If Len(sParentFolder) <> 0 Then
        CreateSubfolders sParentFolder, "Period1", "Period2", "Period3"  '...ect
    End If

End Sub


Regards.
 

Forum statistics

Threads
1,141,012
Messages
5,703,730
Members
421,312
Latest member
Mooncake1

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top