'============================== 
    '創(chuàng)建多級目錄，可以創(chuàng)建不存在的根目錄 
    '參數：要創(chuàng)建的目錄名稱，可以是多級 
    '創(chuàng)建目錄的根目錄從當前目錄開始 
    '''調用舉例 
    ''Call CreateMultiFolder("/upload/jumbot/myphoto/") 
    '============================== 

    Function CreateMultiFolder(ByVal CFolder) 
        Dim objFSO, PhCreateFolder, CreateFolderArray, CreateFolder 
        Dim i, ii, CreateFolderSub, PhCreateFolderSub, BlInfo 
        BlInfo = False 
        CreateFolder = CFolder 
        On Error Resume Next 
        Set objFSO = Server.CreateObject("Scripting.FileSystemObject") 
        If Err Then 
            Err.Clear() 
            Exit Function 
        End If 
        If Right(CreateFolder, 1) = "/" Then 
            CreateFolder = Left(CreateFolder, Len(CreateFolder) -1) 
        End If 
        CreateFolderArray = Split(CreateFolder, "/") 
        For i = 0 To UBound(CreateFolderArray) 
            CreateFolderSub = "" 
            For ii = 0 To i 
                CreateFolderSub = CreateFolderSub & CreateFolderArray(ii) & "/" 
            Next 
            PhCreateFolderSub = Server.MapPath(CreateFolderSub) 
            If Not objFSO.FolderExists(PhCreateFolderSub) Then 
                objFSO.CreateFolder(PhCreateFolderSub) 
            End If 
        Next 
        If Err Then 
            Err.Clear() 
        Else 
            BlInfo = True 
        End If 
        CreateMultiFolder = BlInfo 
    End Function

'自動創(chuàng)建多極目錄
'code by jb51 reterry
function createit(path)
dim fsofo,cinfo,thepath,thepatharray
dim i,ii,binfo
binfo=false
thepath=path
set fsofo=createobject("scripting.filesystemobject")
if err then
err.clear
exit function
end if
thepath=replace(thepath,"\","/")
if left(thepath,1)="/" then
thepath=right(thepath,len(thepath)-1)
end if
if right(thepath,1)="/" then
thepath=left(thepath,len(thepath)-1)
end if
thepatharray=split(thepath,"/")
for i=0 to ubound(thepatharray)
createfoldersub1=createfoldersub1&thepatharray(i)&"/"
createfoldersub=server.mappath(createfoldersub1)
if not fsofo.folderexists(createfoldersub) then
fsofo.createfolder(createfoldersub)
end if
next
if err then
err.clear
else
binfo=true
end if
createit=binfo
end function

    '============================== 
    ''創(chuàng)建文件目錄(多層) 
    ''使用正則 
    '============================== 

    Function Create_N_Folder(save, ByVal Path) 
        Dim Fso 
        Set Fso = Server.CreateObject("Scripting.FileSystemObject") 
        If Not Fso.FolderExists(Path) Then 
            Dim regEx 
            Set regEx = New RegExp 
            regEx.Pattern = "^(.*)\\([^\\]*)$" 
            regEx.Global = False 
            regEx.IgnoreCase = True 
            save = save & regEx.Replace(Path, "$2") & "|" 
            Path = regEx.Replace(Path, "$1") 
            If Create_N_Folder(save, Path) Then Create_N_Folder = True 
            Set regEx = Nothing 
        Else 
            If save = "|" Then 
                Create_N_Folder = True 
            Else 
                Dim Temp 
                Temp = Mid(save, 2, Len(save) - 2) 
                If InStrRev(Temp, "|") = 0 Then 
                    save = "|" 
                    Path = Path & "\" & Temp 
                Else 
                    Dim Folder 
                    Folder = Mid(Temp, InStrRev(Temp, "|") + 1) 
                    save = "|" & Mid(Temp, 1, InStrRev(Temp, "|") - 1) & "|" 
                    Path = Path & "\" & Folder 
                End If 
                Fso.CreateFolder Path 
                If Create_N_Folder(save, Path) Then Create_N_Folder = True 
            End If 
        End If 
        Set Fso = Nothing 
    End Function