求助在Dir1控件当前目录下新建一个文件夹的代码

[sx大歌]

求助在Dir1控件当前目录下新建一个文件夹的代码？
谢谢！

[of123]

MkDir Dir1.Path & "\新建文件夹"

[sx大歌]

引用 1 楼 of123 的回复:

MkDir Dir1.Path & "\新建文件夹"

首先谢谢老师！ 继续求助：1、文件夹建立后刷新一下Dir1，显示这个新建的文件夹； 2、如果当前文件夹中已有一个“新建文件夹”会出错，运行提示“路径访问错误”，请解决？

[of123]

Option Explicit

Private Sub Command1_Click()
Dim i As Long, strPath As String

    strPath = Dir1.Path & "\新建文件夹"
    i = 1
    If Dir(strPath, vbDirectory) > "" Then '2
        Do Until Dir(strPath & i, vbDirectory) = ""
            i = i + 1
        Loop
    End If
    MkDir strPath & i
    Dir1.Refresh                           '1
End Sub

[sx大歌]

谢谢老师！ 刷新的功能有了，第二个问题还是存在，即按二次时，在MkDir strPath & i上出错。If Dir(strPath, vbDirectory) > "" Then 是否有问题？

[of123]

改一下：

Option Explicit

Private Sub Command1_Click()
Dim i As Long, strPath As String

    strPath = Dir1.Path & "\新建文件夹"
    i = 1
    If Dir(strPath, vbDirectory) > "" Then '2
        Do Until Dir(strPath & i, vbDirectory) = ""
            i = i + 1
        Loop
        MkDir strPath & i
    Else
        MkDir strPath
    End If
    Dir1.Refresh                           '1
End Sub

[sx大歌]

后面不断递加数字，如果原来没“新建文件夹”+ 数的文件夹，应该可以实现，但如已有这类名称，就会出错，把代码改成以下这样较方便 Dim strPath As String strPath = Dir1.Path & "\新建文件夹" If Dir(strPath, vbDirectory) = "" Then MkDir Dir1.Path & "\新建文件夹" Else MsgBox " 当前目录下已有一个名为“新建文件夹” ！ ", 16 Exit Sub End If Dir1.Refresh '1 如果 MBox 函数调用一个可输入其他字符的对话框的话会更完美点，胆还得对输入的名称遍历一次。

[sx大歌]

谢谢老师，我发时还没显示你的修改后代码，老师就是高，遍历时只要含有搜索到一次含有“新建文件夹”变量递加就不会有我想的问题了，谢谢！ 还有问题，总追问不好意思了，另开一贴了