VBA to create folder if it doesnt exist

fishep6

New Member
Joined
Feb 10, 2014
Messages
43


Hi I need a Macro that will create a folder based on thefile path that exists in a specific cell.





Cell I4 contains the name of the new folder i.e. - “NewFolder 1”


Cell I2 is the file path of the directory it needs to bemade in i.e - “J:\” (Please note I cannot make this a static location as itwill change based on other details in the form and that's why I need to makethe formula look at a cell value)


Cell I5 is the name the excel file will be named as


Cell I6 is the full filepath created by I2 + I4 ie. - “j:\NewFolder 1”


My sub below will make this folder if it doesn’t exist and thensave the excel file in it, however I need it to check whether the folder existsand if it does then all the VBA needs to do is save the file in this locationwith the file name which is in cell I5


At the moment if the folder already exists the Macro justfails and I have googled many things and cant figure out the correct code I need.Many thanks in advance






Code:
[FONT=Calibri][SIZE=3][COLOR=#000000]Private Sub CommandButton1_Click()[/COLOR][/SIZE][/FONT]





[FONT=Calibri][SIZE=3][COLOR=#000000]'unprotect the password lock on the sheet[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]Sheets("Review Form").UnprotectPassword:="1"[/COLOR][/SIZE][/FONT]



[FONT=Calibri][SIZE=3][COLOR=#000000]'copies and pastes the values in the sheet removing all theformulas[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]Dim ws AsWorksheet[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]Set ws =ThisWorkbook.Sheets("Review Form")[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]ws.UsedRange.Value= ws.UsedRange.Value[/COLOR][/SIZE][/FONT]





[FONT=Calibri][SIZE=3][COLOR=#000000]'removes thereview save button[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]ActiveSheet.Shapes.Range(Array("CommandButton1")).Select[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]Range("G1").Select[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]ActiveSheet.Shapes.Range(Array("CommandButton1")).Select[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]Selection.Delete[/COLOR][/SIZE][/FONT]



[FONT=Calibri][SIZE=3][COLOR=#000000]'Splits the work book into a new work book with 1 tab[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]Dim wb As Workbook[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]Sheets("ReviewForm").Copy[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]Set wb =ActiveWorkbook[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]'creates a folder based on the value in I4 and creates it inthe directory listed in I2[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]Dim folname As String[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]folname = Range("I4").Value[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]MkDir (Range("I2") & folname)[/COLOR][/SIZE][/FONT]



[FONT=Calibri][SIZE=3][COLOR=#000000]'Saves the file in a particular location based on the schemecode[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]Dim SaveName As String[/COLOR][/SIZE][/FONT]



[FONT=Calibri][SIZE=3][COLOR=#000000]'cell I5 contains the name of the file[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]SaveName =ActiveSheet.Range("I5").Text[/COLOR][/SIZE][/FONT]



[FONT=Calibri][SIZE=3][COLOR=#000000]'cell I6 contains the name of the file path where it shouldbe saved - including the new sub folder that needs to be created[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]ActiveWorkbook.SaveAs Filename:=ActiveSheet.Range("I6") &_[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]SaveName& ".xlsm" _[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000],FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False[/COLOR][/SIZE][/FONT]



[FONT=Calibri][SIZE=3][COLOR=#000000]'protects the password lock on the sheet[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]Sheets("Review Form").ProtectPassword:="1"[/COLOR][/SIZE][/FONT]

[FONT=Calibri][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/CO[/COLOR][/SIZE][/FONT]DE]
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Try
Code:
If Dir(Range("I6").Value, vbDirectory) = vbNullString Then MkDir (Range("I6").Value)
 
Upvote 0
Thank you for the quick reply, what part of my original code shall I delete and replace with this?

this part?

Dim folname As String

folname = Range("I4").Value

MkDir (Range("I2") & folname)
 
Upvote 0
It replaces this line
Code:
MkDir (Range("I2") & folname)
 
Upvote 0

Forum statistics

Threads
1,214,982
Messages
6,122,575
Members
449,089
Latest member
Motoracer88

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