一个有关创建文件夹的问题

Question

aa=Inputbox "输入路径"
if dir(aa)="" then Mkdir aa

Answer 1

Dir 函数:返回一个 String，用以表示一个文件名、目录名或文件夹名称，它必须与指定的模式或文件属性、或磁盘卷标相匹配。
MkDir 语句:创建一个新的目录或文件夹。

Answer 2

Dir 函数：返回一个 String，用以表示一个文件名、目录名或文件夹名称，它必须与指定的模式或文件属性、或磁盘卷标相匹配；
MkDir 语句：创建一个新的目录或文件夹。

Answer 3

是aa=Inputbox （输入路径）吧？

Answer 4

对.
aa=Inputbox("输入路径"）

Answer 5

用mkdir也是行不通的，因为象创建f:\mssql\data这样的文件夹，因为f:\mssql不存在，所以f:\mssql\data就无法创建

Answer 6

请教泰山先生，如果我要创建的文件夹为f:\mssql\data，那aa和弹出的对话框中的textbox中都应该是什么值？

Answer 7

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
   
   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:WriteErrLog Nothing, "CreateDir", 1151
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

Answer 8

小女子万分感谢Bardo(巴顿)先生的慷慨相助，只可惜我到这里的时间太少，能给的分数不够，否则我一定给你一个高分！再次感谢。希望大家能多多帮助我，我想向你们好好学习一下。:)

Answer 9

不过，Bardo(巴顿)先生好象忘了把GetDriveType函数的代码写上来了，能尽快发上来吗？

Answer 10

MakeSureDirectoryPathExists
可以递归创建目录，用法请查一下MSDN

Answer 11

'以下两个函数分别用于确认一个路径和文件是否存在，
'如果不存在，则自动生成此路径或文件。
’经测试，用于多个工程
Public Function AffirmDir(NewDir As String) As String
    'by yezi
    Dim Tmp() As String, TmpDir$, i%, Attr As Integer
    Tmp = Split(NewDir, "\")
    TmpDir = Tmp(0)
    On Error Resume Next
    For i = LBound(Tmp) + 1 To UBound(Tmp)
        TmpDir = TmpDir & "\" & Tmp(i)
        Err.Clear
        Attr = GetAttr(TmpDir)
        Select Case Err.Number
        Case 53 'file not found error
            MkDir TmpDir
        End Select
    Next i
    AffirmDir = TmpDir
    On Error GoTo 0
End FunctionPublic Function AffirmFile(NewDir As String) As Integer
    'by yezi
    Dim Tmp() As String, TmpDir$, i%, Attr As Integer
    Tmp = Split(NewDir, "\")
    TmpDir = Tmp(0)
    On Error Resume Next
    For i = LBound(Tmp) + 1 To UBound(Tmp) - 1
        TmpDir = TmpDir & "\" & Tmp(i) '路径合成
        Err.Clear
        Attr = GetAttr(TmpDir)
        Select Case Err.Number
        Case 53 'file not found error
            MkDir TmpDir
        End Select
    Next i
    On Error GoTo 0
    TmpDir = TmpDir & "\" & Tmp(i) '带路径的文件名
    If Dir(TmpDir) = "" Then
        Dim FNum As Integer
        FNum = FreeFile
        Open TmpDir For Output As #FNum
        Close #FNum
        AffirmFile = 0 '成功建立新文件
    Else
        AffirmFile = -1 '旧文件已经存在
    End If
End Function

Answer 12

谢谢floodzhu(吃睡长)和yeya(鸭鸭)！：）

Answer 13

to mudboy():
    如果你是因为爱好VB而要和我交朋友，我欢迎！如果不是，请自己放弃！