VB FSO自动生成N层目录!

Public Function SoCPath(DirPath As String) As Boolean
If DirPath = "" Then SoCPath = False: Exit Function
Dim fso As New FileSystemObject
Dim TmpPath, TmpDrive, TmpDirPath As String
Dim TmpArr() As String
Dim I As Integer
If fso.DriveExists(Left(DirPath, 1) & ":") = False Then MsgBox "此计算机并没有" & UCase(Left(DirPath, 1)) & "盘!": SoCPath = False: Exit Function
If fso.Drives(Left(DirPath, 1)).DriveType = CDRom Then MsgBox "此盘符为光驱,请勿选择!": SoCPath = False: Exit Function
TmpDrive = Left(DirPath, 3)
TmpPath = Replace(DirPath, TmpDrive, "")
If Right(TmpPath, 1) = "/" Then TmpPath = Left(TmpPath, Len(TmpPath) - 1)
TmpArr = Split(TmpPath, "/")
For I = 0 To UBound(TmpArr)
If I = 0 Then TmpDirPath = TmpDrive & TmpArr(I) Else TmpDirPath = TmpDirPath & "/" & TmpArr(I)
If fso.FolderExists(TmpDirPath) = False Then MkDir TmpDirPath
Next
SoCPath = True
End Function