VBA Excel create folder tree based on the variables

Question

I would like to create the folder tree in VBA Excel based on the variables, which will be the UK postcodes.

https://en.wikipedia.org/wiki/List_of_postcode_areas_in_the_United_Kingdom

So, the first folder should be like shown below:

I would like to have the main folder with the major postcode city and some subfolders with the towns falling under this particular postcode city inside.

My piece of code looks like this:

Dim PCode as range
Dim BPcode As String, GPcode As String, PCity As String

Dim SelectedRow As Long

Dim PathName As String
Dim folderName As String, folderNameFull As String, subfolderName As String, fileName As String
Dim FinalPath As String

Set Target = ActiveCell

SelectedRow = Target.Row

Set WAddress = cstws.Range("K" & SelectedRow)
Set City = cstws.Range("L" & SelectedRow)
Set PCode = cstws.Range("M" & SelectedRow)

BPcode = Split(PCode, " ")(0)
GPcode = Remove_Number(BPcode)

Select Case GPcode
 Case "NN"
 PCity = "Northampton"
 End Select

 PathName = GetLocalPath(ThisWorkbook.path) & "\"

 folderName = RemoveForbiddenFilenameChars(UCase(PCity))
 folderNameFull = folderName & " [" & GPcode & "]"
 subfolderName = RemoveForbiddenFilenameChars(UCase(City))
 fileName = RemoveForbiddenFilenameChars(WAddress)

 If subfolderName = "" Then MsgBox "What is the Site Address City?", vbCritical: Exit Sub
 If fileName = "" Then MsgBox "Address incorrect or not provided", vbCritical: Exit Sub

 If Dir(PathName & folderNameFull, vbDirectory) = "" Then
    MkDir PathName & folderNameFull
 Else
    MsgBox "The Folder " & folderNameFull & " already exists"
 End If

 If Dir(PathName & folderNameFull & subfolderName, vbDirectory) = "" Then
    MkDir PathName & folderNameFull & subfolderName
 Else
    MsgBox "The Folder " & subfolderName & " already exists"
 End If


Function RemoveForbiddenFilenameChars(ByVal fileName As String) As String
Const forbiddenChars As String = "\/:*?""<>|[]" '[ and ] are excel specific
Dim i As Long, j As Long
Dim currChar As String

j = 0
For i = 1 To Len(fileName)
    currChar = Mid(fileName, i, 1)
    If InStr(forbiddenChars, currChar) = 0 And (AscW(currChar) > 31) Then
        j = j + 1
        Mid(fileName, j, 1) = currChar
    End If
Next i

RemoveForbiddenFilenameChars = Left(fileName, j)
End Function

Function Remove_Number(Text As String) As String
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "[0-9]"
Remove_Number = .Replace(Text, "")
End With
End Function

The functions used in this code can be found here:

VBA Excel - problem with saving file on newly created folder

As a result my folder tree is wrong. I neither have the correct name for the main folder, nor the subfolder placed inside.

The other solutions:

Create folders and subfolders based on two variables Creating Automatic Folders based on excel list Excel vba: creating folders doesn't work How to create folders using Excel VBA?

didn't work so far.

How could I create the folder tree in VBA Excel based on 2 values?

score 2 · Accepted Answer · answered Mar 29 '23 at 12:15

2

Here is a Sub that will create a folder and sub folder based on two inputs. This is a bare-bones solution to show the idea. You will need to error handle, and modify it to fit your situation, but it should get you on track.

Option Explicit

Private Sub CreateNewFolder(Level1 As String, Level2 As String)

    ' Purpose:
    ' Create a new folder in the same folder this file named Level1, and within create another folder named Level2
    
    ' Notes:
    ' The Microsoft Scripting Runtime reference is required for this Sub
    
    ' Get the folder this file is in
    Dim FileSystemObject As New Scripting.FileSystemObject, CurrentFolder As Scripting.Folder
    Set CurrentFolder = FileSystemObject.GetFolder(ThisWorkbook.Path)
    
    ' Create a new folder
    Dim NewFolderPath As String
    NewFolderPath = CurrentFolder.Path & Application.PathSeparator & Level1
    
    ' If the folder already exists, a Runtime Error 58 is thrown here
    FileSystemObject.CreateFolder Path:=NewFolderPath
    
    ' Create a new folder
    Dim NewSubFolderPath As String
    NewSubFolderPath = NewFolderPath & Application.PathSeparator & Level2
    FileSystemObject.CreateFolder Path:=NewSubFolderPath
    
End Sub

answered Mar 29 '23 at 12:15

TehDrunkSailor

633
4
11

The code looks promisigly, but 2 errors came out: 1. Path not found: for the line: Set CurrentFolder = FileSystemObject.GetFolder(ThisWorkbook.path) 2. When I apply the following pattern for folder1: Folder1 = UCase(PCity) & "(" & GPcode & ")" only the value in brackets comes, but where is the first value? – Geographos Mar 29 '23 at 13:15
I found solution for the second one, but still wondering what's wrong with the first one, as Path is not found. – Geographos Mar 29 '23 at 14:08
The "Path no found" error sounds like your workbook isn't saved anywhere. Make sure your workbook is saved somewhere, and then try again. I don't follow your second question. What is "Folder1"? Do you mean "Level1", the first argument of the `Sub`? Regardless, are you sure that your variable PCity isn't just an empty string? – TehDrunkSailor Mar 29 '23 at 14:12
OK, sorted everything. Not used your whole code, but it included key pieces, which helped me a lot. Thank you so much! – Geographos Mar 29 '23 at 14:18
Absolutely, glad to hear that you're modifying it, that's the whole point! :) – TehDrunkSailor Mar 29 '23 at 14:19

VBA Excel create folder tree based on the variables

1 Answers1