The following sub will create the path 'sPath' if not already present. Call it using the code in CreateFolderTest
Note that the code corrects illegal filename characters in the cell G3 and also for no content in G3.
Sub CreateFolderTest()
Dim sFolder As String
sFolder = CleanFilename(Range("G3"))
If Not sFolder = "" Then
CreateFolders "C:\Test\" & sFolder & "\"
Else
MsgBox "The cell G3 content is invalid", vbCritical
End If
End Sub
Private Function CleanFilename(strFileName As String) As String
'Graham Mayor - https://www.gmayor.com
Dim arrInvalid() As String
Dim lng_Index As Long
'Define illegal characters (by ASCII CharNum)
arrInvalid = Split("9|10|11|13|34|42|47|58|60|62|63|92|124", "|")
'Remove any illegal filename characters
CleanFilename = strFileName
For lng_Index = 0 To UBound(arrInvalid)
CleanFilename = Replace(CleanFilename, Chr(arrInvalid(lng_Index)), Chr(95))
Next lng_Index
lbl_Exit:
Exit Function
End Function
Private Function CreateFolders(strPath As String)
'A Graham Mayor/Greg Maxey AddIn Utility Macro
Dim strTempPath As String
Dim lng_Path As Long
Dim VPath As Variant
Dim oFSO As Object
Dim i As Integer
Set oFSO = CreateObject("Scripting.FileSystemObject")
VPath = Split(strPath, "\")
If Left(strPath, 2) = "\\" Then
strPath = "\\" & VPath(2) & "\"
For lng_Path = 3 To UBound(VPath)
strPath = strPath & VPath(lng_Path) & "\"
If Not oFSO.FolderExists(strPath) Then MkDir strPath
Next lng_Path
Else
strPath = VPath(0) & "\"
For lng_Path = 1 To UBound(VPath)
strPath = strPath & VPath(lng_Path) & "\"
If Not oFSO.FolderExists(strPath) Then MkDir strPath
Next lng_Path
End If
lbl_Exit:
Set oFSO = Nothing
Exit Function
End Function