PDA

View Full Version : Create New Folders - Input Box



dj44
03-20-2017, 10:10 AM
Morning folks:)


I am trying to Select a range and create new folders from that range

I am using a input box to hold my range.

Somethings not right




Sub MakeFolders()


On Error Resume Next

Dim rng As Range, cell As Range, path As String
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row



' input box for selecting range of cells in excel
Set rng = Application.Selection

Set rng = Application.InputBox("Range", xTitleId, rng.Address, Type:=8)

Set rng = Application.InputBox("Range", ActiveSheet.Range)

'Set rng = Application.InputBox("Range", xTitleId, rng)


'Set rng = ActiveSheet.Range("F2:F1050")


path = "C:\Users\DJ\Desktop\New Folders\"



For Each cell In rng

MkDir path & cell
Next

Set rng = Nothing
Set cell = Nothing

http://windowssecrets.com/forums/showthread.php/173290-Excel-to-folders
End Sub


Can some one please take a look at my input box

i appreciate your help thank you

mdmackillop
03-20-2017, 10:22 AM
Don't automatically "Resume Next"; best to see what is causing errors

Dim rng As Range, cell As Range, path As String

'On Error Resume Next
Set rng = Application.InputBox("Range", "Select Range", Type:=8)
path = "C:\Users\DJ\Desktop\New Folders\"
For Each cell In rng
MkDir path & cell
Next
Set rng = Nothing
Set cell = Nothing

dj44
03-20-2017, 11:33 AM
Hello M,

I now get a error on
MkDir path & cell

but i most definately have a folder on my desktop called "New Folders"

So i dont know why its being so troublesome

mdmackillop
03-20-2017, 12:14 PM
Should it be "New Folder"?

dj44
03-20-2017, 12:35 PM
I also tried it with just outputting a few cells to the desktop.
Still same error path not found path = "C:\Users\DJ\Desktop\"

Path not found

mdmackillop
03-20-2017, 02:44 PM
Try this

Sub test()
Dim rng As Range, cell As Range, path As String
Dim chk
'On Error Resume Next
Set WshShell = CreateObject("WScript.Shell")
path = WshShell.SpecialFolders("Desktop") & "\New Folder"


'Check for "New Folder"; Create if required
chk = Dir(path, vbDirectory)
If Len(chk) = 0 Then MkDir path
path = path & "\"

'Creat sub folders
Set rng = Application.InputBox("Range", "Select Range", Type:=8)
For Each cell In rng
MkDir path & cell
Next cell
Set rng = Nothing
Set cell = Nothing


End Sub

dj44
03-20-2017, 03:40 PM
Thank you for the code M,

I have found out what the problem is

When I put this code in the personal.xlsb it works

The minute I put it in a xlam or xlsm it gives me the

Path not found error

Any ideas why?

I would like to put this In my xlsm so I can use it too