Create a folder using Macro

[Krishnakuma6]

Dear Experts,​

I have data in column c in excel sheet, I want to create a folder in my network drive, Now I am using the following Code for that, but I have problem, Once I create a folder (including sub folders) and if I rename the some sub folders,then when I run the macro again the renamed sub folders are created again.I want to amend the code,if main folder is existing then no need to create a sub folders other wise create a main folder & sub folders

Sub CreateDirs()
Dim R As Range
Dim RootFolder As String
RootFolder = "J:\WORKWINNING\CLIENT 2013" '<<< CHANGE 1"
For Each R In Range("C162:C600") '<<< CHANGE 2
If Len(R.Text) > 0 Then
On Error Resume Next
MkDir RootFolder & "\" & "HQ " & R.Text
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Bid No Bid Form"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Clarification & Addenda"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Contract Award"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Contract Variation"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Draft Tender Proposal"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Estimation"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Expression of Interest"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Final Tender Proposal"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Post Tender Clarification & Meetings"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "PQQ"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Presentation"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "RFP"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Site Visit Input"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Sub Contractor Proposal"
On Error GoTo 0
End If
Next R
MsgBox "Hi " & CreateObject("Outlook.application").Getnamespace("MAPI").CurrentUser & " Folder Created"
End Sub​

 

[Firefly2012]

Please give this a try:

Sub CreateDirs()
Dim R As Range
Dim RootFolder As String
RootFolder = "J:\WORKWINNING\CLIENT 2013" '<<< CHANGE 1"
For Each R In Range("C162:C600") '<<< CHANGE 2
If Len(R.Text) > 0 Then
If Dir(RootFolder & "\" & "HQ " & R.Text,vbDirectory)="" Then
On Error Resume Next

MkDir RootFolder & "\" & "HQ " & R.Text
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Bid No Bid Form"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Clarification & Addenda"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Contract Award"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Contract Variation"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Draft Tender Proposal"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Estimation"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Expression of Interest"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Final Tender Proposal"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Post Tender Clarification & Meetings"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "PQQ"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Presentation"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "RFP"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Site Visit Input"
MkDir RootFolder & "\" & "HQ " & R.Text & "\" & "Sub Contractor Proposal"
On Error GoTo 0
End if
End If
Next R
MsgBox "Hi " & CreateObject("Outlook.application").Getnamespace("MAPI").CurrentUser & " Folder Created"
End Sub

 

[Krishnakuma6]

Re: Create a folder using Macro (Solved)

Dear Firefly2012,
Thx for your quick reply,now it's working fine
K.murthy

 

[Firefly2012]

Re: Create a folder using Macro (Solved)

You're welcome