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
 

Some videos you may like

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,977
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
7,977
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,113,812
Messages
5,544,458
Members
410,613
Latest member
Texman
Top