Question

我有用于在用户桌面上创建新文件夹的代码。我想为其添加更多功能。在创建新文件夹之前，它应该检查文件夹是否已经存在（现在正在这样做）。然后，如果存在具有相同名称的文件夹，则代码应创建具有下一个可用数字1,2,3 ...的新文件夹。

因此，如果已经存在名为“ T34-23，报价”的文件夹，则代码应创建名为“ T34-23，报价1”的文件夹。如果存在“ T34-23，报价1”，则创建“ T34-23，报价2”等。

 Sub MakeMyFolder()

    Dim fdObj As Object
    Application.ScreenUpdating = False
    Set fdObj = CreateObject("Scripting.FileSystemObject")
    If fdObj.FolderExists(Environ$("USERPROFILE") & "\Desktop\" & ThisWorkbook.Sheets("Other Data").Range("AK2").Value & ", " & _
    ThisWorkbook.Sheets("Other Data").Range("AK7").Value) Then
        'MsgBox "Found it.", vbInformation, "Excel"
    Else
        fdObj.CreateFolder (Environ$("USERPROFILE") & "\Desktop\" & ThisWorkbook.Sheets("Other Data").Range("AK2").Value & ", " & _
    ThisWorkbook.Sheets("Other Data").Range("AK7").Value)
        'MsgBox "It has been created.", vbInformation, "Excel"
    End If

    Set fdObj = Nothing
    Application.ScreenUpdating = True
End Sub

Answer 1

正如@urderboy建议的那样，您应该在其中使用一些变量。

Function CheckAndSuffixFolder(strPathToCheck As String, _
                                Optional blnCreateFolder As Boolean = False) As String

Dim f As New Scripting.FileSystemObject
Dim l As Long
Dim s As String

s = strPathToCheck
l = 1

Do While f.FolderExists(s)
    l = l + 1
    s = strPathToCheck & l
Loop

If blnCreateFolder Then f.CreateFolder s

CheckAndSuffixFolder = s

End Function

这样打电话，我有Folder，FOlder1和FOlder2。

CheckAndSuffixFolder("C:\Workspace\Training\Folder")给我Folder3

Answer 2

现在无法对其进行测试，但是我认为该解决方案将要求您循环访问数字，直到有一个该值返回False为止。如果文件检查返回True，则文件存在，直到您达到所需的数量为止。未经测试的代码：

Dim  createFile Boolean: createFile = False
Dim i as Integer: i = 1

Do while createFile = False
Dim strDir As String
    strDir = folderDir & "T34-23, Quotation" & i & "\"
    If Dir(strDir, vbDirectory) = "" Then
         MkDir strDir
    createFile = True
    Else
     i = i+1
    End If

wend

如果文件夹已经存在，请在文件夹名称中添加下一个数字

2 个答案: