VBA: код для создания подпапок и папок не работает

Question

Я получил этот код из онлайн-источника и не могу понять, что мне нужно изменить, чтобы он работал, папки не создаются в нужном месте, и я не знаю, где они будут созданы, если где-нибудь?

В Excel у меня есть 3 командные кнопки, одна для сохранения файла в указанном месте, одна для отправки его коллегам по электронной почте и, наконец, командная кнопка, с которой у меня возникают проблемы.Я включу изображения ниже.

И возможно ли вызвать цепную реакцию между кодами, что, как только один из них будет завершен, начнется другой, так как я могу заставить их работать так, как они работают на своем собственном АТМ.

введите описание изображения здесь

Answer 1

Mkdir может создать только один каталог. Вы пытаетесь сделать два, поставляя "9999 William Cox ltd \ BRAKEL".

Сначала создайте "9999 William Cox ltd", затем создайте его дочерние каталоги.

Вот код, который сгенерирует все подкаталоги с помощью цикла:

Добавьте эти функции в ваш кодовый модуль:

Private Function makeDir(parentDir As String, childDir As String) As String
    'Checks if supplied directory name exists in current path, if not then create.
    childDir = parentDir & _
        IIf(Left(childDir, 1) = "\", "", "\") & _
        childDir & _
        IIf(Right(childDir, 1) = "\", "", "\")

    On Error Resume Next
    MkDir childDir
    On Error GoTo 0

    makeDir = childDir
End Function

Public Sub makePath(parentDir As String, childPath As String)
    Dim i As Integer
    Dim subDirs As Variant
    Dim newdir As String
    Dim fPath As String

    fPath = parentDir
    subDirs = Split(childPath, "\")

    For i = 0 To UBound(subDirs)

        newdir = subDirs(i)
        fPath = makeDir(fPath, newdir)

    Next i

End Sub

Затем замените это:

MkDir ("T:\Estimating\William Cox Project Enquiries 2018\" & fPath)
If Err.Number <> 0 Then
    Err.Clear
End If

При этом:

makePath "T:\Estimating\William Cox Project Enquiries 2018\", fpath

Вам также следует удалить On Error Resume Next, чтобы вы могли перехватить любые другие ошибки - еще одна из которых может быть на вашем пути (согласно скриншоту), в которой в начале дважды указано «T: \ Estimating».