View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
JP[_3_] JP[_3_] is offline
external usenet poster
 
Posts: 168
Default Code to create folder and subfolders

Hey I thought you might like to know I found this code on Chip
Pearson's website, should do what I am looking for so I'm posting the
link.

http://www.cpearson.com/excel/MakeDirMulti.htm

Thx,
JP


On Oct 16, 1:47 pm, "Crowbar via OfficeKB.com" <u15117@uwe wrote:
This will create a directory tree if it doenst exsist.

CheckDir is the important bit for you as this is the directory name you will
be looking for

I have set up an example. This should check if "C:\MatchBox\64\" exsists. If
it doenst you will be prompted and then it wil create it

Function CreateDir()

Dim Fso
Dim Answer
Dim File
Dim w As Long
Dim TargetDir As Boolean
Dim CheckDir As String
TargetDir = False

CheckDir = "C:\MatchBox\64\"
File = CheckDir
Set Fso = CreateObject("Scripting.FileSystemObject")
'Checks if the whole save directory exists, if it doesn't it finds out
what is missing

If Not Fso.folderexists(File) Then

For w = 1 To Len(CheckDir)

If Mid(CheckDir, w, 1) = "\" Then
File = Mid(CheckDir, 1, w)
Set Fso = CreateObject("Scripting.FileSystemObject")

If Not Fso.folderexists(File) Then

If TargetDir = False Then

Answer = MsgBox("The save dir '" & CheckDir & "' does not
exsit" & Chr(10) & Chr(10) & "Would you like to create it?", vbInformation +
vbYesNo, "Save Directory Error")

If Answer = vbYes Then
TargetDir = True
On Error GoTo errorhandler
MkDir File
Else
Exit Function
End If

ElseIf TargetDir = True Then
MkDir File
End If

End If

End If

Next w

End If

TargetDir = False

errorhandler:
If Err.Number 10 Then
MsgBox "Cannot Create Dir!!!"
End If

End Function

--
Message posted via OfficeKB.comhttp://www.officekb.com/Uwe/Forums.aspx/excel-programming/200710/1