VBA code to create & name an empty folder

[stuo81]

Hi

I need some VBA code to give the following effect if anyone can help.

I want macro code so I can have a button which when pressed will create an empty folder on the desktop of the current computer which the sheet is on. (this needs to be able to work on any computer the sheet is used on or forwarded to etc).

The original sheet with the button on described above will have 3 text boxes and a date cell. If possible I would like the newly created folder to be automatically renamed with the content of the 3 text boxes and the date in the cell. EG ‘textbox1words-textbox2words-textbox3words-22/11/13’. I can change the format the date is shown in the cell too as I’m sure the / wont work.

Any help is much appreciated.

Thanks

 

[stuo81]

Hi yeah I've changed TextBox1, TextBox2 & TextBox3 to txtWO, txtAddress, & txtWIRS respectively.- I missed a braket - ha. I'm not getting the syntax error now but I am getting the error msg from the code 'What the hell went wrong' in your code?

 

[Snakehips]

The code works AOK for me with Windows.
Are you on the Mac???
If so then it wil be failing to get the path to the desktop and I am at a loss as to how to help with that.

 

[stuo81]

No I'm on a windows laptop at the min I think its the date range bit its having a problem with.

Can you copy it in again for me with the text box names I just put above and also how have you got your date cell (w4) formatted before the code changes it?

 

[Snakehips]

Stu,

Code if textboxes are Activex via controls toolbox.....

Sub New_Folder_Ax()
'If Activex text boxes
On Error GoTo Oops
GoTo Create
Oops:
MsgBox "What the hell went wrong?"
On Error GoTo 0
Exit Sub
Create:
With ActiveSheet
MyFolder = .txtWO.Value & "-" & .txtAddress.Value & "-" & .txtWIRS.Value & "-" & Format(Range("W4"), "dd-mm-yy")
'edit range A4 above, to suit cell that holds your date
End With
MyPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & MyFolder
If Len(Dir(MyPath, vbDirectory)) = 0 Then
MkDir MyPath
Else
MsgBox "Folder already exists"
End If
On Error GoTo 0
End Sub

If regular textbox inserted from Insert -Text tab........

Sub New_Folder()
On Error GoTo Oops
GoTo Create
Oops:
MsgBox "What the hell went wrong?"
On Error GoTo 0
Exit Sub
Create:
With ActiveSheet
MyFolder = .TextBoxes("txtWO").Text & "-" & .TextBoxes("txtAddress").Text & "-" & .TextBoxes("txtWIRS").Text & "-" & Format(Range("W4"), "dd-mm-yy")
'edit range A4 above, to suit cell that holds your date
End With
MyPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & MyFolder
If Len(Dir(MyPath, vbDirectory)) = 0 Then
MkDir MyPath
Else
MsgBox "Folder already exists"
End If
On Error GoTo 0
End Sub

Hope that helps.

 

[stuo81]

Thats superb - They are Activex text boxes and that code has worked a treat. Thanks very much you've taken away a big head ache, but I'm sure I'll have more in the future MrExcel can help with ha I might even figure things out for myself now and again!!!

Cheers again Tony