vba检查目录是否存在，如果存在则退出，否则如果不存在，则创build

好的，所以我有下面的vba代码，我正在使用它来检查一个目录是否存在，如果不是像这样创build文件夹结构：

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 

所以我的目标path是我的S:\驱动器

然后根据单元格c中的值，我想要检查该文件夹是否存在，所以如果单元格c中包含单词“tender”，那么该目录将如下所示：

 'S:\Tender' 

如果不存在，则创build，否则，如果存在，则继续前进，并使用单元格M中的值在此文件夹中创build另一个文件夹，如下所示：

 Cell M = Telecoms 'S:\Tender\Telecoms' 

最后，检查'S：\ Tender \ Telecoms'中是否存在单元格Z中的值的文件夹，如果不是，则创build它。

 Cell Z = 12345 

所以我们最终会：

 'S:\Tender\Telecoms\12345\' 

由于某些原因我不断收到错误消息path未find。 请有人告诉我我要去哪里错了？ 提前致谢

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

 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 

Answer 3

MkDir命令只会创build一个新的子目录级别。

 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