Folder Structure

ShogunStealth

New Member
Joined
Nov 6, 2021
Messages
28
Office Version
  1. 2019
Platform
  1. Windows
I am archiving a large number of websites, but I need to mimic the structure of the back end of the website with a similar folder structure. I can extract the text but I need to easily create the folder structure based on the example below of small example. Column E show group section [yellow], non yellow are sub folders. Parent / Child relationship, each parent may have numerous child folders or none at all. When 'none' I will not make folder or path. Column F,G helps set the conditions see below;

False / Parent -> Parent
True / Parent -> not possible
True / Child -> Child of previous Parent (top down) eg Parent\Child
False / Child -> No Path or Folder

I need a formula or VBA to create Column I [Green] for every line item. I am using Excel 2016. The example is indicative of larger sites so any code needs to adapt dynamically to a longer list. The number of Parent groupings should be limited the 5 highlighted in Yellow but determined by Column F and G.

Creating the folder structure (Column I) on the desktop under a top folder called 'Website' or user entered option with a dummy file (text file called 'Dummy) in each folders would be a bonus.

Thank you for any help

CaptureMR Excel.PNG
 
Hello,

Please find below a proposition. You need to adjust topleftcell to your case, and also i did make you manually pickup the website folder because i had big troubles with onedrive and mine, the usual Environ(“USERNAME”) & “\Desktop” was not working with fso.FolderExists…
VBA Code:
Public Sub StructureWebsite()
  Dim topLeftCell As String: topLeftCell = "E1"
  Dim mainFolder As String
  
  Dim dialog As FileDialog
  Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
  With dialog
    .Title = "Choose Website Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then
      Exit Sub
    End If
    mainFolder = .SelectedItems(1)
  End With

  ' retriving folders list
  Dim foldersList As Variant
  With ActiveSheet.Range(topLeftCell)
    foldersList = Range(.Cells, .Offset(, 2).End(xlDown)).Value2
  End With
  
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  Dim i As Long, currentParent As String
  For i = LBound(foldersList, 1) To UBound(foldersList, 1)
    Select Case CStr(foldersList(i, 3))
    Case "Parent"
      currentParent = mainFolder & "\" & CStr(foldersList(i, 1))
      fso.CreateFolder currentParent
    Case "Child"
      If foldersList(i, 2) Then fso.CreateTextFile (currentParent & "\dummy.txt")
    End Select
  Next i
End Sub
 
Upvote 0
Thank you for the code, and happy with the folder picker option.

I ran it but was only getting the parent layer created, it doesn't appear to be looping for the second layer of folders. It wasn't creating the second layer ie document Libraries\Shared Documents etc...

It was placing the dummy.txt in only the folders that have sub folders but not the folders. It should be placing dummy.txt in all folders and subfolders. Am I doing something wrong?

Note the image below. The table on the left is what I'm getting

I'm missing the orange folders and yellow files on the right

Capturepart2.PNG
 
Upvote 0
Hi,
You are right the code was incorrect. Please find below the corrected revision.
I get the correct structure this time.
VBA Code:
Option Explicit

Public Sub StructureWebsite()
  Dim topLeftCell As String: topLeftCell = "E1"
  Dim mainFolder As String
  
  Dim dialog As FileDialog
  Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
  With dialog
    .Title = "Choose Website Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then
      Exit Sub
    End If
    mainFolder = .SelectedItems(1)
  End With

  ' retriving folders list
  Dim foldersList As Variant
  With ActiveSheet.Range(topLeftCell)
    foldersList = Range(.Cells, .Offset(, 2).End(xlDown)).Value2
  End With
  
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  Dim i As Long, currentParent As String, currFolder As String
  For i = LBound(foldersList, 1) To UBound(foldersList, 1)
    Select Case CStr(foldersList(i, 3))
    Case "Parent"
      currentParent = mainFolder & "\" & CStr(foldersList(i, 1))
      fso.CreateFolder currentParent
    Case "Child"
      currFolder = currentParent
      If foldersList(i, 2) Then
        currFolder = currFolder & "\" & CStr(foldersList(i, 1))
        fso.CreateFolder currFolder
      End If
      fso.CreateTextFile currFolder & "\dummy.txt"
    End Select
  Next i
End Sub
 
Upvote 0
Solution
Hi Saboh - what can I say brilliant, I have always struggled with the reading in a list of content and applying formulas through an Array like feature.

If I had a folder structure 3 (instead of 2) layers deep I imagine the code would be something like

Select Case CStr(foldersList(i, 3))
Case "Parent"
currentParent = mainFolder & "\" & CStr(foldersList(i, 1))
fso.CreateFolder currentParent
Case "Child"
currFolder = currentParent
If foldersList(i, 2) Then
currFolder = currFolder & "\" & CStr(foldersList(i, 1))
fso.CreateFolder currFolder
End If
Case "Baby"
currPathFolder = currFolder ! - New variable
If foldersList(i, 2) Then
currFolder = currPathFolder & "\" & CStr(foldersList(i, 1))
fso.CreateFolder currFolder
End If
fso.CreateTextFile currFolder & "\dummy.txt"
End Select

Thank you very much in advance and for your time to answer my puzzle :)
 
Upvote 0
Yes that's 100% correct, congrats!

However, it is fast and easy to proceed in this way since you have an already sorted list and ONLY 2 or 3 "levels". If we wanted to generalize for n "levels" (let's say instead of Parent/Child/Baby/Embryo... you'd use 1/2/3…/n), it would be interesting to rethink the procedure to be the same for all n cases. This can be done in different ways, but it implies more complex programming.

In conclusion, if you're working with let's say a maximum 5 cases, I think the current procedure is good enough.

Have a good day
 
Upvote 0
Thanks again for the in sight, would I also be correct in suggesting the following, when a parent folder is created we need to add a line in the Case = "Parent" to create a dummy file because "currFolder" is not assigned until Case = "Child"/ "Baby"

elect Case CStr(foldersList(i, 3))
Case "Parent"
currentParent = mainFolder & "\" & CStr(foldersList(i, 1))
fso.CreateFolder currentParent

fso.CreateTextFile currentParent & "\dummy.txt" ! ---- New Entry

Case "Child"
currFolder = currentParent
If foldersList(i, 2) Then
currFolder = currFolder & "\" & CStr(foldersList(i, 1))
fso.CreateFolder currFolder
End If
Case "Baby"
currPathFolder = currFolder ! - New variable
If foldersList(i, 2) Then
currFolder = currPathFolder & "\" & CStr(foldersList(i, 1))
fso.CreateFolder currFolder
End If
fso.CreateTextFile currFolder & "\dummy.txt"
End Select
 
Upvote 0
Hi,

I think you got a good grasp on the code, and the adaptation you propose are all valid. At the end it all depends on the goal you want to achieve: it's up to you to choose where and under which conditions to put a dummy file or not.

Since you manage to adapt the code by yourself, i suggest you mark one post as solution. If you do not need further help on this topic of course.

Have a good day
 
Upvote 0

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
Back
Top