- Код: Выделить всё
'MkFolder subroutine
' Creates specified folder
' Accepts any valid non-UNC path, even if none of its components
' has yet been created
' Could work with both slashes / and backslashes \
' Doesn't return an error, except for the case you entered invalid path
'author: hCORe <entropia@fluda.net>
Public Sub MkFolder(sFolder As String)
On Error Resume Next
If Len(sFolder) < 4 Then
On Error GoTo 0
Err.Raise 5, "MkFolder", "Invalid argument: folder path should be at least 4 characters long."
End If
ChDrive Left$(sFolder, 3)
If Right$(sFolder, 1) = "\" Then sFolder = Mid$(sFolder, 1, Len(sFolder) - 1)
'replace slashes to backslashes
sFolder = ReplTxt(sFolder, "/", "\")
Dim aSubs() As String
'split string into an array
aSubs = Split(sFolder, "\")
Dim i As Long
Dim sMake As String
'walk through the path, skipping element 0 (drive)
sMake = aSubs(0)
For i = 1 To UBound(aSubs)
sMake = sMake & "\" & aSubs(i)
MkDir sMake
Next
'cleanup
Erase aSubs()
Err.Clear
End Sub
'ReplTxt Function
' Wrapper for VBA.Replace
'author: hCORe <entropia@fluda.net>
Public Function ReplTxt(sWhere As String, sWhat As String, sReplace As String, Optional eCompare As VbCompareMethod = vbBinaryCompare) As String
On Error Resume Next
Dim sTmp As String
sTmp = sWhere
sTmp = VBA.Replace(sTmp, sWhat, sReplace, , , eCompare)
If sTmp = sWhat Then sTmp = sWhere
ReplTxt = sTmp
End Function
Пример использования:
- Код: Выделить всё
'create folder
MkFolder "C:\ABC/DEF/GHI/jkl/mno\pqr/stu/vwx\yz/my_folder"
'show it in Windows Explorer
Shell "explorer C:\ABC", vbNormalFocus
Этот код создаст папку C:\ABC\DEF\GHI\jkl\mno\pqr\stu\vwx\yz\my_folder и откроет ее в "Проводнике".