vba 检查目录是否存在，如果存在则退出sub 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:\ 驱动器

然后根据单元格 c 中的值，我希望它检查该文件夹是否存在，因此如果单元格 c 中有单词 'tender'，那么目录将如下所示：

'S:\Tender'

如果不存在，则创建，否则如果存在，则继续并在此文件夹中创建另一个文件夹，其值在单元格 M 中，如下所示：

Cell M = Telecoms

'S:\Tender\Telecoms'

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

Cell Z = 12345

所以我们最终会得到：

'S:\Tender\Telecoms345\'

出于某种原因，我一直收到找不到路径的错误消息。请有人可以告诉我我要去哪里错了吗？提前致谢

Answer 1

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 2

前段时间我写了这个我放在图书馆里的小东西：

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 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

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

vba check if directory exists, if exists exit sub else if does not exist, create

excel

vba

createfile