Если папка уже существует, добавьте следующий номер к имени папки

Question

У меня есть код для создания новой папки на рабочем столе пользователя.Я хотел бы добавить больше функциональности к нему.Перед созданием новой папки она должна проверить, существует ли папка (она делает это прямо сейчас).Затем, если есть папка с тем же именем, код должен создать новую папку со следующим доступным номером 1,2,3 ...

Так что, если папка с именем "T34-23, Quotation" уже существует, коддолжен создать папку с именем "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

Не могу проверить это сейчас, но я думаю, что решение потребует от вас циклически перебирать числа, пока не найдется одно значение, которое возвращает 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

Answer 2

Как подсказывает @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