'========================================================================= '创建日期: 2011-06-17,hellostory '函数说明: 创建多级目录 '参数说明: 多级目录的路径名 '========================================================================= Public Function createMultiLevelFolder(path As String) As Boolean On Error GoTo errHandler Dim index As Integer, tempPath As String createMultiLevelFolder = False If Len(Trim(path)) = 0 Then Exit Function End If index = InStr(1, path, "/") Do While index > 0 tempPath = Left(path, index) '这里index(“/”所在的位置)可视为要截取的字符长度 If tempPath = "//" Then '对“//”后面的主机名或IP不处理 index = InStr(index + 1, path, "/") Else If Dir(tempPath, vbDirectory) = "" Then MkDir tempPath End If End If index = InStr(index + 1, path, "/") '返回下一个“/”的位置 Loop createMultiLevelFolder = True errHandler: If Err.Number Then MsgBox "创建多级目录(" & path & ")时出错:" & Err.Description, vbInformation, "错误" createMultiLevelFolder = False Resume Next End If End Function