Dave,
Thank you that is exactly what I was looking for I just modified
it a little bit and it worked for me.

Code Follows:

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


Sub Create_Directory()
' From Dave Peterson via microsoft.public.excel.worksheet.functions
group.
' Create MyDirRoot and Declare as a String Variable
Dim MyDirRoot As String
' Place a Value for the Root Directory
MyDirRoot = "Reporting"
' Make a Directory using the value in D2 from the previously sorted
report
MakeDir "c:\" & MyDirRoot & "\" & Format(Range("d2").Value, "yyyy\
\mm MMMM\\dd")
End Sub


Sub MakeDir(DirPath As String)
If Right(DirPath, 1) < "\" Then DirPath = DirPath & "\"
MakePath DirPath
End Sub

This gave me a directory structure of C:\Reporting\2007\12 December\07

In other words It was great!

On Dec 4, 4:35 pm, Dave Peterson wrote:
How about:

Option Explicit
Sub testme()
Dim Fldr As Scripting.FileSystemObject
Dim MyDirYear As String
Dim MyDirMonth As String
Dim MyDirMonth2 As String
Dim MyDirDay As String
Dim MyDirRoot As String

MyDirRoot = "Reports\"
MyDirYear = Format(Range("D2").Value, "YYYY")
MyDirMonth = Format(Range("D2").Value, "mm")
MyDirMonth2 = Format(Range("D2").Value, "MMMM")
MyDirDay = Format(Range("D2").Value, "dd")

Set Fldr = New Scripting.FileSystemObject
If Fldr.FolderExists("C:\" & MyDirRoot) Then
If Fldr.FolderExists("C:\" & MyDirRoot & "\" & MyDirYear) Then
'already there
Else
Fldr.CreateFolder "C:\" & MyDirRoot & "\" & MyDirYear
End If
Else
Fldr.CreateFolder "C:\" & MyDirRoot
Fldr.CreateFolder "C:\" & MyDirRoot & "\" & MyDirYear
End If

End Sub

Or you could use something that Jim Rech Posted:

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

Sub Test()
MakeDir "c:\reports\2007"
End Sub

Sub MakeDir(DirPath As String)
If Right(DirPath, 1) < "\" Then DirPath = DirPath & "\"
MakePath DirPath
End Sub

====
In fact, it looks like you may want:

MakeDir "c:\" & mydirroot & "\" & Format(Range("d2").Value, "yyyy\\mm\\dd")





wrote:

Alright I have been playing around with the code a little bit and this
is what happens

Code:

Dim Fldr As Scripting.FileSystemObject
Dim MyDirYear As String
Dim MyDirMonth As String
Dim MyDirMonth2 As String
Dim MyDirDay As String
Dim MyDirRoot As String

MyDirRoot = "Reports\"
MyDirYear = Format(Range("D2").Value, "YYYY")
MyDirMonth = Format(Range("D2").Value, "mm")
MyDirMonth2 = Format(Range("D2").Value, "MMMM")
MyDirDay = Format(Range("D2").Value, "dd")

Set Fldr = New Scripting.FileSystemObject
If Fldr.FolderExists("C:\" & MyDirRoot & "\" & MyDirYear) Then
Else
Fldr.CreateFolder "C:\" & MyDirRoot & "\" & MyDirYear
End If

End Sub

This results in an error in line 76 "Path Not Found"

However, if I take out the "\" I get the following results and use the
code modified like this

Dim Fldr As Scripting.FileSystemObject
Dim MyDirYear As String
Dim MyDirMonth As String
Dim MyDirMonth2 As String
Dim MyDirDay As String
Dim MyDirRoot As String

MyDirRoot = "Reports"
MyDirYear = Format(Range("D2").Value, "YYYY")
MyDirMonth = Format(Range("D2").Value, "mm")
MyDirMonth2 = Format(Range("D2").Value, "MMMM")
MyDirDay = Format(Range("D2").Value, "dd")

Set Fldr = New Scripting.FileSystemObject
If Fldr.FolderExists("C:\" & MyDirRoot & MyDirYear & MyDirMonth &
MyDirMonth2 & MyDirDay) Then
Else
Fldr.CreateFolder "C:\" & MyDirRoot & MyDirYear & MyDirMonth &
MyDirMonth2 & MyDirDay
End If

End Sub

I get the following results:

C:\Reports2007

Thanks,
Christopher

On Dec 4, 8:43 am, wrote:
Thank you for your answer, but I am getting an error Path Not found. I
made sure that the workbook with the needed value is the active
workbook before starting this macro.

the Value in D2 is 12/4/07 08:25 AM it was a converted number to date
format the original number was stored as 39423.35069 but thecellis
formated to date format before this macro is run. The Format I use is
[$-409]mm/dd/yy hh:mm AM/PM;@

On Dec 4, 8:08 am, Pranav Vaidya

wrote:
Hi

I think you can try this-

Dim Fldr As Scripting.FileSystemObject

Dim mMyDir as String

mMyDir=Format(Range("D2").Value,
"YYYY") & "\" & Format(Range("D2").Value, "mm") & " " &
Format(Range("D2").Value, "MMMM") &"\" & Format(Range("D2").Value,
"dd")

Set Fldr = New Scripting.FileSystemObject
If Fldr.FolderExists("C:\Reports\"&mMyDir) Then
Else
Fldr.CreateFolder "C:\Reports\"&mMyDir
End If

HTH,
--
Pranav Vaidya
VBA Developer
PN, MH-India
If you think my answer is useful, please rate this post as an ANSWER!!

" wrote:
I previously posted this to the incorrect group. Sorry about that.

I was able to create a partial structure from information in a
previous post.

Post Follows:
From user: Farhad

Dim Fldr As Scripting.FileSystemObject
Set Fldr = New Scripting.FileSystemObject
If Fldr.FolderExists("C:\Reports\2007-09-18") Then
Else
Fldr.CreateFolder "C:\Reports\2007-09-18"
End If

make sure you have referred to MicroSoft Scripting Runtime from
ToolsReferences

Thanks,
--
Farhad Hodjat

Question:
Assuming that the value ofCellD2 is a date in the format 12/2/07
18:39.

I would like to create the following file structure from that
information

Drive:\Place Where Data is Stored\Year\Month (two digit) Month
(Verbal)
\Day (two digit)

So with the data fromCellD2 it would look like this:

Drive:\Place Where Data is Stored\2007\12 December\02\

I have used the following adjustment to the data and can't seem to
get
the full file structure.

"Drive:\Place Where Data is Stored\" & Format(Range("D2").Value,
"YYYY") & "\" & Format(Range("D2").Value, "mm") & " " &
Format(Range("D2").Value, "MMMM") &"\" & Format(Range("D2").Value,
"dd")

With the previous formula I either get an error or nothing happens at
all or I get adirectorystructure like this "Drive:\Place Where Data
is Stored\200711\ or Drive:\Place Where Data is Stored\200711November
\. The workbook where the data is contained is the active workbook.- Hide quoted text -

- Show quoted text -- Hide quoted text -

- Show quoted text -

--

Dave Peterson- Hide quoted text -

- Show quoted text -