I com from Dutch my englisch is not zo good.

‘will give a false indication of the
‘ folder non-existance. To be sure to detect a directory…

Change: -2 to -1 in For Next
For i = 0 To UBound(ArryDir) – 1

‘ This will not detect a directory unless it contains a file.

If Len(Dir(sBaseFolder & sTemp)) = 0 Then
‘Use MkDir to create the folder
MkDir sBaseFolder & sTemp
End If

‘ I adapted the Procedure to create multiple new directories if not existing
‘ It uses a loop to check each directory and create it if not existing.

Sub CreateFolders(sFolderPath As String)
Dim sSubFolder As String
Dim sBaseFolder As String
Dim sTemp As String

ArryDir = Split(sFolderPath, “”)

For i = 0 To UBound(ArryDir) – 2
sBaseFolder = sBaseFolder & ArryDir(i)
sSubFolder = ArryDir(i + 1)
‘Make sure the base folder is ready to have a sub folder
‘tacked on to the end
If Right(sBaseFolder, 1) “” Then
sBaseFolder = sBaseFolder & “”
End If

‘Make sure base folder exists
If Len(Dir(sBaseFolder, vbDirectory)) > 0 Then
‘Replace illegal characters with an underscore
sTemp = CleanFolderName(sSubFolder)
‘See if already exists: Thanks Dave W.
If Len(Dir(sBaseFolder & sTemp, vbDirectory)) = 0 Then
‘Use MkDir to create the folder
MkDir sBaseFolder & sTemp
End If
End If
Next
End Sub

Private Function CleanFolderName(ByVal sFolderName As String) As String

Dim i As Long
Dim sTemp As String

For i = 1 To Len(sFolderName)
Select Case Mid$(sFolderName, i, 1)
Case “/”, “”, “:”, “*”, “?”, “”, “|”
sTemp = sTemp & “_”
Case Else
sTemp = sTemp & Mid$(sFolderName, i, 1)
End Select
Next i

CleanFolderName = sTemp

End Function

Sam

You should check for the folder’s existence after you clean the illegal characters. Otherwise, you run the risk of trying to create a folder that already is there.

David