Hi all,

Does anyone have code that can create parent folders automatically (if
they don't exist)?

For example I use MkDir to create folders. Currently I am doing it
this way:

MkDir FolderA
MkDir FolderA\FolderB
MkDir FolderA\FolderB\FolderC

to create FolderC

Is there a way to just write in the lowest subfolder (FolderA\FolderB
\FolderC) and Excel/VBA would create the parent folders on its own, if
they don't exist?

Thx!

--JP

Hi JP,
You can try :

Private Declare Function MakeSureDirectoryPathExists _
Lib "imagehlp.dll" (ByVal lpPath As String) As Boolean

Sub CreateDirectoryStructure()
On Error GoTo 1
MakeSureDirectoryPathExists "C:\FolderA\FolderB\FolderC\FolderD\"
Exit Sub
1: MsgBox "Error " & Err.Number & vbLf & Err.Description, 64
End Sub

Regards,
MP

"JP" <(E-Mail Removed)> a écrit dans le message de news:
(E-Mail Removed)...
> Hi all,
>
> Does anyone have code that can create parent folders automatically (if
> they don't exist)?
>
> For example I use MkDir to create folders. Currently I am doing it
> this way:
>
> MkDir FolderA
> MkDir FolderA\FolderB
> MkDir FolderA\FolderB\FolderC
>
> to create FolderC
>
> Is there a way to just write in the lowest subfolder (FolderA\FolderB
> \FolderC) and Excel/VBA would create the parent folders on its own, if
> they don't exist?
>
> Thx!
>
> --JP
>

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.com
http://www.officekb.com/Uwe/Forums.a...mming/200710/1

Thank you, I modified your code as follows. It's a bit awkward with
all of the IF statements, but it gets the job done. However, at my
office we use UNC paths which means the first pass causes the macro to
see every CheckDir variable as non-existent. Is there a way to account
for the initial double-slash?


Sub CreateDir()

Dim Fso As Scripting.FileSystemObject
Dim sFolder As String
Dim w As Long
Dim TargetDir As Boolean
Dim CheckDir As String

TargetDir = False

CheckDir = "\\p111filclu01\Drug\RANDOMS\NewClient\2007\DOT\"
sFolder = 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(sFolder) Then
For w = 1 To Len(CheckDir)
If Mid(CheckDir, w, 1) = "\" Then
If w > 1 Then
If Mid(CheckDir, w - 1, 2) <> "\\" Then
sFolder = Mid(CheckDir, 1, w)
If Not Mid(sFolder, w, 2) = "\\" Then
If Not Fso.folderexists(sFolder) Then
If TargetDir = False Then
Select Case MsgBox("The directory '" &
CheckDir & "' does not exist" & vbCrLf & vbCrLf & "Would you like to
create it, along with with its parent folders?", vbYesNo)
Case vbYes
TargetDir = True
On Error GoTo errorhandler
MkDir sFolder
Case Else
Exit Sub
End Select
ElseIf TargetDir = True Then
MkDir sFolder
End If
End If
End If
End If
End If
End If
Next w
End If

TargetDir = False

Exit Sub

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


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

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