'==============================     '創建多級目錄，可以創建不存在的根目錄     '參數：要創建的目錄名稱，可以是多級     '創建目錄的根目錄從當前目錄開始     '''調用舉例     ''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

'自動創建多極目錄'code by jb51 reterryfunction createit(path)dim fsofo,cinfo,thepath,thepatharraydim i,ii,binfobinfo=falsethepath=pathset fsofo=createobject("scripting.filesystemobject")if err thenerr.clearexit functionend ifthepath=replace(thepath,"/","/")if left(thepath,1)="/" thenthepath=right(thepath,len(thepath)-1)end ifif right(thepath,1)="/" thenthepath=left(thepath,len(thepath)-1)end ifthepatharray=split(thepath,"/")for i=0 to ubound(thepatharray)createfoldersub1=createfoldersub1&thepatharray(i)&"/"createfoldersub=server.mappath(createfoldersub1)if not fsofo.folderexists(createfoldersub) thenfsofo.createfolder(createfoldersub)end ifnextif err thenerr.clearelsebinfo=trueend ifcreateit=binfoend function

    '==============================     ''創建文件目錄(多層)     ''使用正則     '==============================     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