怎么样直接用MKDIR建立深层目录？
今天真高兴，专家分超过1000了。
不过，很奇怪，我没得什么分啊？
谁给我加的？？？
问题点数：200、回复次数：2Top
1 楼kailong（凯龙）回复于 2002-03-06 22:03:53 得分 20
什么意思呀？Top
2 楼Bardo（巴顿(永远只有一个)）回复于 2002-03-06 22:05:23 得分 180
你可以查看：我得分的问题
Public Function CreateDir(ByVal strDirName As String, _
SucceedDir As String) As Boolean
'*****************************************************************
'函数功能：创建新的多级目录
'参数：strDirName：要创建的目录
' SucceedDir: 成功创的目录
'成功则返回:True
'*****************************************************************
Dim DirArrStr As Variant
'逐段检测其有效性。
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim NewDirStr As String
Dim NoValidChar As Variant
Dim nDriveType As Long
Dim GnDriveType As Integer
On Error GoTo HELL
'创建目录的无效字串(此处不包括":",因为有驱动器):
NoValidChar = Array("*", ">", "<", "?", "|", Chr(34), "/")
'字符转换为有效性字串：
Dim bReplace As Boolean
For j = 0 To 6
If InStr(1, strDirName, NoValidChar(j), vbTextCompare) <> 0 Then
If MsgBox("所给路径字串含非法字符，如要继续创建，这些字符将被删除。要继续创建吗？", _
vbCritical Or vbYesNo, "") = vbYes Then
bReplace = True
Exit For
Else
CreateDir = False
Exit Function
End If
End If
Next j
'如果需要转换
If bReplace = True Then
For k = 0 To 6
strDirName = Replace(strDirName, NoValidChar(k), "")
Next k
End If
'先将目录分为字符段
strDirName = Trim(strDirName)
strDirName = IIf(Right(strDirName, 1) = "\", Left(strDirName, Len(strDirName) - 1), strDirName)
DirArrStr = Split(strDirName, "\")
NewDirStr = ""
For i = 0 To UBound(DirArrStr)
If i = 0 Then
If Right(DirArrStr(i), 1) = ":" Then
If DirExists(DirArrStr(i) & "\") Then
NewDirStr = DirArrStr(i) & "\"
nDriveType = GetDriveType(NewDirStr)
If GnDriveType <> DRIVE_FIXED Then
If GnDriveType = DRIVE_CDROM Then
MsgBox "无法在光驱上创建目录！", vbCritical Or vbOKOnly, "区域信息化管理系统"
CreateDir = False
Exit Function
ElseIf GnDriveType = DRIVE_REMOTE Then
If MsgBox("所给路径驱动非本地驱动器，如要继续创建，这将不利于系统的运行。要继续创建吗？", _
vbCritical Or vbYesNo, "") = vbNo Then
CreateDir = False
Exit Function
End If
End If
End If
Else
WriteErrLog Nothing, "CreateDir", 1068, "所给路径非法，无法创建！"
End If
Else
WriteErrLog Nothing, "CreateDir", 1081, "所给路径非法，无法创建！"
CreateDir = False
Exit Function
End If
Else
'有效字串长度不为0
If Len(DirArrStr(i)) <> 0 Then
'检测是否存在，不存在则创建
If DirExists(NewDirStr & DirArrStr(i) & "\") = False Then
If InStr(1, DirArrStr(i), ":", vbTextCompare) <> 0 Then
If MsgBox("所给路径字串含非法字符，如要继续创建，这些字符将被删除。要继续创建吗？", _
vbCritical Or vbYesNo, "") = vbNo Then
CreateDir = False
Exit Function
End If
End If
MkDir NewDirStr & DirArrStr(i) & "\"
End If
NewDirStr = NewDirStr & DirArrStr(i) & "\"
End If
End If
Next i
SucceedDir = NewDirStr
CreateDir = True
Exit Function
HELL:
Err.Clear
CreateDir = False
End Function
Public Function DirExists(ByVal strDirName As String) As Boolean
'*****************************************************************
'函数功能：返回目录是否存在
'存在则返回:True
'*****************************************************************
Const strWILDCARD$ = "*.*"
Dim strDummy As String
On Error Resume Next
strDirName = IIf(Right(strDirName, 1) = "\", strDirName, strDirName & "\")
strDummy = Dir$(strDirName & strWILDCARD, vbDirectory)
DirExists = Not (strDummy = vbNullString)
Err = 0
End Function
Top
相关问题
关键词
得分解答快速导航
相关链接
广告也精彩
反馈
