Folder Creation

  • Thread starter Thread starter Gaurav
  • Start date Start date
G

Gaurav

Hi,

I am currently creating folders on the basis of below macro, wherein I
pick up the path names from Sheet1, Range A1:A100 and thereafter it
creates the folder.
Sub CreateFolder()
Dim cell As Range
For Each cell In ThisWorkbook.Sheets("Sheet1"). _
Range("A1:100").SpecialCells(xlCellTypeConstants)
MkDir cell.Value
Next cell
End Sub

I would like to edit the macro to include the following (esp. Point a
and b)
a) It should check if the folder exists, if that folder exists, it
will not create that folder.
b) Secondly, I have currently mentioned range of data as A1:A100, I
would like to extend the range automatically based on the data
c) Thirdly, Suppose I want to create folder at path C:\Test\Test2 and
if folder Test does not exist, it should create two folders- Test and
Test2. (It would be ok if points a and b are solved).

Is there any one who could help me out with this.

Thanks,
Gaurav
 
Hi,

I am currently creating folders on the basis of below macro, wherein I
pick up the path names from Sheet1, Range A1:A100 and thereafter it
creates the folder.
   Sub CreateFolder()
   Dim cell As Range
   For Each cell In ThisWorkbook.Sheets("Sheet1"). _
   Range("A1:100").SpecialCells(xlCellTypeConstants)
   MkDir cell.Value
   Next cell
   End Sub

I would like to edit the macro to include the following (esp. Point a
and b)
a) It should check if the folder exists, if that folder exists, it
will not create that folder.
b) Secondly, I have currently mentioned range of data as A1:A100, I
would like to extend the range automatically based on the data
c) Thirdly, Suppose I want to create folder at path C:\Test\Test2 and
if folder Test does not exist, it should create two folders- Test and
Test2. (It would be ok if points a and b are solved).

Is there any one who could help me out with this.

Thanks,
Gaurav
Click to expand...

a) Use error handling
---------------------------->
Sub MakeDir()

qdirectory = Range("A1").Value

On Error Resume Next
mkdir qdirectory
On Error GoTo 0

End Sub
----------------------------------
b) how is your data structured?
You could use the Selection object. First select a range and then use
(for each cell in Selection)

c) Trickier, but not impossible. Are a and b solved?

Anthony
http://www.excel-ant.co.uk
 
Hi

From the Excel VBA help system

Description FolderExists

Returns True if a specified folder exists; False if it does not.

Syntax

object.FolderExists(folderspec)

The FolderExists method syntax has these parts:

Part Description
object Required. Always the name of a FileSystemObject.
folderspec Required. The name of the folder whose existence is to be
determined. A complete path specification (either absolute or relative) must
be provided if the folder isn't expected to exist in the current folder.
 
Hi again,

For the second question

Dim Bot as Long
Bot=Range("A1").End(XLDown).Row

ThisWorkbook.Sheets("Sheet1"). _
Range("A1:" & Bot).SpecialCells(xlCellTypeConstants)
 
Jim Rech posted this API function that is very nice:

Option Explicit
Declare Function MakePath Lib "imagehlp.dll" Alias _
"MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long

Sub testme()
dim myCell as range
dim myRng as range
dim myPath as string

with worksheets("Sheet1")
set myrng = .range("a1",.cells(.rows.count,"A").end(xlup))
end with

for each mycell in myrng.cells
mypath = mycell.value
if right(mypath, 1) <> "\" then
mypath = mypath & "\"
end if
MakePath mypath
next mycell

End Sub
 
You may want to test to see if the folder exists after the attempt. (If you use
a mapped drive that doesn't exist (like x:), you may want to see a warning:

Option Explicit
Declare Function MakePath Lib "imagehlp.dll" Alias _
"MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long

Sub testme()
Dim myCell As Range
Dim myRng As Range
Dim myPath As String
Dim res As Long

With Worksheets("Sheet1")
Set myRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each myCell In myRng.Cells
myPath = myCell.Value
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If
res = MakePath(myPath)
If res = 1 Then
'ok
Else
MsgBox myPath & " does not exist!"
End If
Next myCell

End Sub
 
Back
Top