macro to create folder and subfolder and file inside subfolder each one with specific name

Good Day, mazan

There are, I believe, many ways to check for and Create Folders and Sub Folders.


This may help get you started: ( The code is not too efficient, as there are lots of extra and unnecessary steps and variable usage, but this should aid you to understand better what is going on as well as aid in later modification to meet your exact requirements )

1- macro

This will work , for example, on this data_....

Using Excel 2007 32 bit

Row\Col	A
1	XYT
2	XTC

_....in the First Worksheet of the File in which the Code is, and it will make you two Folders with the names XYT and XTC in the same Folder in which The File in which the code is in, or it will evoke a message box to tell you if the Folders already exist





1-macro:

Note
Line 80 This sets the string of the Full Path up to your main Folders. You will need to adjust this to suit where you want to store the main Folders

Sub mazan1_macro()   '  Post #2  '  http://www.excelforum.com/excel-programming-vba-macros/1154519-macro-to-create-folder-and-subfolder-and-file-inside-subfolder-each-one-with-specific-name.html
10   Rem 1 Workbooks, Worksheets info. some Variable declarations
20   '1a ) File Info, Paths, File names
30   Dim WB As Workbook                                             ' Dim:  ' Preparing a "Pointer" to an Initial "Blue Print" in Memory of the Object ( Pigeon Hole with a bit of paper or code lines on that can be filled in to refer to a specific Objec of this type ) . This also us to get easily at the Methods and Properties throught the applying of a period ( .Dot) ( intellisense )                     '
40   Set WB = ThisWorkbook                                        ' Set now (to This Workbook - the one this code is in), so that we carefull allways referrence this so as not to go astray through Excel Guessing inplicitly not the one we want...         Set: Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed.      http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191Set ws = ActiveSheet ' Alternative to last line, make code apply to the current active sheet, - That being "looked at" when running this code        '
50   Dim Ws1 As Worksheet: Set Ws1 = WB.Worksheets.Item(1) '      'The Worksheets Collection Object of WB is used referrencing by Item number which is a consecutive count starting at 1 from the left  and increasing by 1 as you count to the right. This Worksheet has the .Name Property applied to return the String Tab Name
60   Dim FolderName As String    ' Prepares "Pointer" to a "Blue Print" (or Form, Questionnaire not yet filled in, a template etc.)"Pigeon Hole" in Memory, sufficient in construction to house a piece of Paper with code text giving the relevant information for the particular Variable Type. VBA is sent to it when it passes it. In a Routine it may be given a particular “Value”, or (“Values” for Objects).  There instructions say then how to do that and handle(store) that(those). At Dim the created Paper is like a Blue Print that has some empty spaces not yet filled in. A String is a a bit tricky. The Blue Print code line Paper in the Pigeon Hole will allow to note the string Length and an Initial start memory Location. This Location well have to change frequently as strings of different length are assigned. Instructiions will tell how to do this. Theoretically a specilal value vbNullString is set to aid in quich checks.. But...  http://www.mrexcel.com/forum/excel-questions/361246-vbnullstring-2.html#post44116
70   Dim strDefpath As String  'String variables for the relavent parts of Folder Path
80    Let strDefpath = WB.Path & "\" 'Default Path as That of where this code is.  CHANGE TO SUIT
90   '1b ) Input Data Info
100  Dim Lr1 As Long, Lr5 As Long '     variables for last rows   ' '  Long is very simple to handle, - final memory "size" type is known (123.456 and 000.001 have same "size" computer memory ) , and so a Address suggestion can be given for the next line when the variable is filled in.  '( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. )
110   Let Lr1 = Ws1.Cells(Rows.Count, 1).End(xlUp).Row '              ' The Range Object ( cell ) that is the last cell in the column of interest (CHOOSE a column typically that will always have a last Entry in any Data) ,( Row Number given by .Count Property applied to ( any Worksheet would do, so leaving unqualified is OK here, ) Spreadsheet Range Columns Property)    has the Property .End ( argument "Looking back up" ) appled to it. This Returns a new Range ( cell ) object which is that of the first Range ( cell ) with something in it "looking back up" in the XL spreadsheet from that last Cell. Then the .Row Property is applied to return a long number equal to the Column number of that cell:    3. Rows.Count is the very last row number in your sheet. It is different for earlier versions of Excel.  The End(xlUp) is the same as pressing a Ctrl+UpArrow key combination. The final ".Row" returns the row where the cursor stops after moving up.
120   'Let Lr1 = Ws1.Cells(Rows.Count, 5).End(xlUp).Row
130  Dim arrCapture() As Variant                                     'This Array is to be used generally to make a single code line "capture" of a spreadsheet range available to us through the .Value, which returns us a field of Variant Types, hence we must Dimension appropriately
140   Let arrCapture() = Ws1.Range("A1:A" & Lr1 & "").Value2 '        .Value Property Returning Field of our Folder names in Column A.  This will return a 1 "column" 2 Dimensional Array
150  Dim arrFolderNames() As String: ReDim arrFolderNames(1 To Lr1) 'Array of string types to hold our Folder Names. ( We know the Types so can Declare appropriately. We also know the size, but are using ReDim as Dim ing an Array to size can only be done with numbers, like Dim arr(1 To 2) as String. The syntax of ReDim allows variables as well as nu8mbers to be used
160  Dim Cnt As Long                                               'Loop Bound variable count
170      For Cnt = 1 To Lr1
180       Let arrFolderNames(Cnt) = arrCapture(Cnt, 1) '            Effectively transposing our 1 "column" 2 Dimensional Array of variant types (housing Strings) to a 1 Dimensional "pseudo horizontal" Array of String types. This extra somewhat unecerssary step is acceptable in my opinion as the transposing loop works very quickly in 1 Dimension and there are often efficiency advantages later in using 1 Dimensional Arrays in VBA Strings Collection Funktions
190      Next Cnt
200  Rem 2 ) Produce Folders or inform ot their existance
210  Dim Stear As Variant                                           'For use in a For Next  Loop  the controling Variable must be of varint or Object type
220      For Each Stear In arrFolderNames() '  could also For Cnt = 1 To Lr1 --
230       Let FolderName = Stear
240          If Len(Dir("" & (strDefpath & FolderName) & "", vbDirectory)) = 0 Then 'If the Directory ( Folder )  does not exist then...
250           MkDir (strDefpath & FolderName) '...make it
260          Else 'The Directory is presumably already there so do not make it again!
270           MsgBox prompt:="Folder """ & FolderName & """ exists already at " & strDefpath & ""
280          End If
290      Next Stear                         '  could also Next Cnt           --
End Sub

_...........................................

2-macro is in discussed in next post.

2-macro
It is not totally clear to me what you want.

I will try to guess what you want, and as before give full ' EP 'explanations so that you may modify to your exact requirements. Again there will be many unnecessary and duplicated sections.

The actual code is given here:
http://www.excelforum.com/showthread...29#post4475000
and here:
http://www.excelforum.com/showthread...t=#post4475062
Note: it is all one Code ( I had to split it due to Forum Post size limits ) The second part of the code should be copied directly under the first part in the same code module.


I tested it on this : ( while _ ........ listening to this
https://www.youtube.com/watch?v=Lo2qQmj0_h4 _...all FuKing Night Long..)
Using Excel 2007 32 bit

Row\Col	A	B	C	D	E
1	XYT				B#152214
2	ACDC				You Shagged Me All Night Long
3	XYT
4	XYT				B#152615

Tabelle1

_.............................

What the code does:

After running the code, based on the above data, you end up with two main Folders named
XYT
and
ACDC

In XYT you end up with two Sub Folders name
B#152214
And
B#152615

In ACDC you end up with one Sub Folder named
You Shagged Me All Night Long

At all points the existence of the Folder is first checked. If it exist you are told that in a message box. If it does not then it is made.
_.....................

Here is a brief description of the code:

10 Rem 1 ) Workbooks info and worksheets and date referencing
Line 80 This sets the string of the Full Path up to your main Folders. You will need to adjust this to suit where you want to store the main folders

Rem 2) Uses the Keys of a Microsoft Scripting Runtime Dictionary to produce finally a 1 dimensional Array_...
760 arrKeys()
_....which contains a list of unique values from Column A

780 Rem 3) This is a basic repeat of 1-macro making the main Folders

890 Rem 4) Sub Folders

900 ' 4a) A Collection is made of a concatenation of values in columns A and E ( ignoring rows with any empty Cell in column A or column E). In the tested example this will be
XYT B#152214
AC/DC You Shagged Me All Night Long
XYT B#152615

980 ' 4b) This produces a 1 dimensional Array of concatenated Strings _...
1020 arrConcat()
-... from that list. In the example we have
XYT B#152214 , ACDC You Shagged Me All Night Long , XYT B#152615


1050 ' 4c) An Outer loop_...
1080
_.... goes loops through for every Unique value from Column A, using the arrKeys()

1120 Produces a 1 Dimensional Array from arrConcat() _..
arrSubFoldersInFolder()
_.....containing only those entries that include the current Unique value

1130 An Inner loop_....
1140
_.... goes through for every value in the arrSubFoldersInFolder() and the name for the Sub Folder is produced by_...
1160
_..... removing the current Unique value from the concatenated String

Lines 1180 – 1240 complete the inner loop by Producing the Sub Folder if it does not exist.

1250 Repeat Outer loop for a new product Name, ( obtained from Unique Product Name List made from Column A )


Alan




‘ https://www.youtube.com/watch?v=Lo2qQmj0_h4
‘ http://www.snb-vba.eu/VBA_Collection_en.html
‘ http://www.snb-vba.eu/VBA_Dictionary_en.html



WillyWonks.JayPeaGee( mazan Diks )
WillyWonks.JPG
https://www.youtube.com/watch?v=Lo2qQmj0_h4
https://www.youtube.com/watch?v=ivFYVAntpw0
https://www.youtube.com/watch?v=Q8fZeaUHsjw

Originally Posted by mazan2010

dear Doc.AElstein
would you please upload example for each

Hi Mazan,
Codes are in Worksheet Codes module for Worksheet "Tabelle1" in uploaded File
Alan

Hi Mazan
What about, ... try to understand and learn from the codes I have done for you.

Then try to modify my 2-macro to do what you finally want.

Then if you have difficulty, Post back and say where / with what you are having difficulty and we will try to help further.

Alan

Hi Mazan
Any progress or feedback from you ?

_......

Here another code Idea.

For 2-macro

This time, 2-macro is put in a Normal Code Module
NormalCodeModule2_2.JPG
http://imgur.com/juAGXGD
NormalCodeModule.JPG
http://imgur.com/c0ggc7x

Main Code is still the same. - ( All just one code but in two parts because of Post size Limitations ) Put in Normal Code Module.
http://www.excelforum.com/showthread...29#post4483094
http://www.excelforum.com/showthread...=2#post4483101


_..................................................................

Worksheet Change Event Code in Worksheets “2-macro” Worksheets Code Module

Worksheets2-macroWorksheetsCodeModule.jpg
http://imgur.com/ox1l70p


I do not change yet what the 2-macro does. I just show you another way to make a code “Automatic”
From here:
http://www.globaliconnect.com/excel/...=79&Itemid=475

This code will start only when you in type an entry in the next free cell in Column A

Code:

 Option Explicit 
Private Sub Worksheet_Change(ByVal Target As Range) ' This code starts "Automatic" - The Worksheet Change Event Code in Worksheets "2-macro" Worksheets Code Module starts when  cells on the worksheet are changed either by the user, or by any VBA application or by an external link, but not when a cell changes due to recalculation as a result from formula or due to format change.
'Code will call existing Public Sub
'Using Target Address. Trigger the procedure, If a Next Free Cell in column A  is changed: 'Target is a reserved by VBA name for a variable of type Range (ie. Target is a Range Object). It refers to the changed Range and can consist of one or multiple cells
'
'
' In this code all Range calls unqualified go to the Worksheet of this code Module, "this worksheet"
' Determine Last Cell
Dim Lr As Long  '  variables for last row in Column A of this worksheet   ' '  Long is very simple to handle, - final memory "size" type is known (123.456 and 000.001 have same "size" computer memory ) , and so a Address suggestion can be given for the next line when the variable is filled in.  '( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. )
Let Lr = Range("A" & Rows.Count & "").End(xlUp).Row '              ' The Range Object ( cell ) that is the last cell in the column of interest (CHOOSE a column typically that will always have a last Entry in any Data) ,( Row Number given by .Count Property applied to ( any Worksheet would do, so leaving unqualified is OK here, ) Spreadsheet Range Columns Property)    has the Property .End ( argument "Looking back up" ) appled to it. This Returns a new Range ( cell ) object which is that of the first Range ( cell ) with something in it "looking back up" in the XL spreadsheet from that last Cell. Then the .Row Property is applied to return a long number equal to the Column number of that cell:    3. Rows.Count is the very last row number in your sheet. It is different for earlier versions of Excel.  The End(xlUp) is the same as pressing a Ctrl+UpArrow key combination. The final ".Row" returns the row where the cursor stops after moving up.

' Start Sub mazan1_macro() only if Cell changed is last Cell in column A, that is to say if Target, the changed range is this cell
Dim LrAddress As String: Let LrAddress = Range("A" & Lr & "").Address
    If Target.Address = LrAddress Then ' condition to run code 2-macro    '      Address must be in same format, here absolute reference and in Capitals.
     Call mazan1_macro ' run 2-macro
    Else ' No action for change not in last used cell in column A. Redundant code
    End If
End Sub

If you are finished with this Thread and want no more help, then please
_ mark Thread as Solved.
( You must be logged in to do this: )
http://imgur.com/8Hebnrn
Or
Reply with comments Please

Alan