vba проверить, существует ли каталог, если существует exit else else, если не существует, создать

Question

Итак, у меня есть следующий код vba, который я использую, чтобы проверить, существует ли каталог, и если не создать структуру папок следующим образом:

If Dir("S:\Tasks\" & Range("C" & ActiveCell.Row).Value & "\" & Range("M" & ActiveCell.Row).Value & "\" & Range("Z" & ActiveCell.Row).Value, vbDirectory) = "" Then 
    MkDir Path:="S:\Tasks\" & Range("C" & ActiveCell.Row).Value & "\" & Range("M" & ActiveCell.Row).Value & "\" & Range("Z" & ActiveCell.Row).Value 
    MsgBox "Done" 
Else 
    MsgBox "found it" 
End If 

так что мой путь назначения моего S:\ диск

затем в зависимости от значения в ячейке с я хочу, чтобы проверить, что папка существует, поэтому, если ячейка с было слово «тендер» в нем, то каталог будет выглядеть так:

'S:\Tender' 

Если это не существует, то создавать, иначе, если это существует, то двигаться дальше и создать другую папку в этой папке со значением в ячейке M следующим образом:

Cell M = Telecoms 

'S:\Tender\Telecoms' 

Тогда, наконец, проверьте папку с значение в ячейке Z существует в 'S: \ Tender \ Telecoms', и если не создать его.

Cell Z = 12345 

поэтому мы в конечном итоге с:

'S:\Tender\Telecoms\12345\' 

Фор какой-то причине я получаю путь сообщение об ошибке не найден. Может кто-нибудь покажет мне, где я ошибаюсь? Заранее спасибо

Answer 1

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

Function CreateFolder(ByVal sPath As String) As Boolean 
'by Patrick Honorez - www.idevlop.com 
'create full sPath at once, if required 
'returns False if folder does not exist and could NOT be created, True otherwise 
'sample usage: If CreateFolder("C:\toto\test\test") Then debug.print "OK" 
'updated 20130422 to handle UNC paths correctly ("\\MyServer\MyShare\MyFolder") 

    Dim fs As Object 
    Dim FolderArray 
    Dim Folder As String, i As Integer, sShare As String 

    If Right(sPath, 1) = "\" Then sPath = Left(sPath, Len(sPath) - 1) 
    Set fs = CreateObject("Scripting.FileSystemObject") 
    'UNC path ? change 3 "\" into 3 "@" 
    If sPath Like "\\*\*" Then 
     sPath = Replace(sPath, "\", "@", 1, 3) 
    End If 
    'now split 
    FolderArray = Split(sPath, "\") 
    'then set back the @ into \ in item 0 of array 
    FolderArray(0) = Replace(FolderArray(0), "@", "\", 1, 3) 
    On Error GoTo hell 
    'start from root to end, creating what needs to be 
    For i = 0 To UBound(FolderArray) Step 1 
     Folder = Folder & FolderArray(i) & "\" 
     If Not fs.FolderExists(Folder) Then 
      fs.CreateFolder (Folder) 
     End If 
    Next 
    CreateFolder = True 
hell: 
End Function 

Answer 2

Команда MkDir создаст только один новый уровень подкаталога.

Sub directory() 
    Dim rw As Long, f As String 

    rw = ActiveCell.Row 
    f = "s:\Tasks" 
    If Not CBool(Len(Dir(f, vbDirectory))) Then 
     MkDir Path:=f 
     Debug.Print "made " & f 
    End If 
    f = f & Chr(92) & Range("C" & rw).Value 
    If Not CBool(Len(Dir(f, vbDirectory))) Then 
     MkDir Path:=f 
     Debug.Print "made " & f 
    End If 
    f = f & Chr(92) & Range("M" & rw).Value 
    If Not CBool(Len(Dir(f, vbDirectory))) Then 
     MkDir Path:=f 
     Debug.Print "made " & f 
    End If 
    f = f & Chr(92) & Range("Z" & rw).Value 
    If Not CBool(Len(Dir(f, vbDirectory))) Then 
     MkDir Path:=f 
     Debug.Print "made " & f 
    Else 
     Debug.Print "it was already there" 
    End If 

End Sub 

Answer 3

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath As String) As Long 

MakeSureDirectoryPathExists "S:\Tasks\" & Range("C" & ActiveCell.Row).Value & "\" & Range("M" & ActiveCell.Row).Value & "\" & Range("Z" & ActiveCell.Row).Value