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

Question

Ok so I have the following vba code which I am using to check if a directory exists and if not create the folder structure like so:

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

So my destination path is my S:\ drive

then depending on the value in cell c I want it to check if that folder exists, so if cell c had the word 'tender' in it then the directory would look like:

'S:\Tender'

If this does not exist, then create, else if this exists then move on and create another folder within this folder with the value in cell M like so:

Cell M = Telecoms

'S:\Tender\Telecoms'

Then finally, check if a folder with the value in cell Z exists within 'S:\Tender\Telecoms' and if not create it.

Cell Z = 12345

so we would end up with:

'S:\Tender\Telecoms\12345\'

Fore some reason I keep getting the error message path not found. Please can someone show me where I am going wrong? Thanks in advance

Patrick Honorez · Accepted Answer · 2015-09-09 08:45:24Z

I wrote some time ago this little thing that I keep in my library:

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

GSerg · Accepted Answer · 2015-09-09 08:50:54Z

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

answered Sep 9, 2015 at 8:50

GSerg

78.8k18 gold badges173 silver badges377 bronze badges

2 Comments

Patrick Honorez Over a year ago

Impressively short and efficient! But does not seem to word with UNC paths, so I'm not deleting my little function yet.

GSerg Over a year ago

@iDevlop It doesn't handle Unicode paths either. Documentation suggests you use SHCreateDirectoryEx for Unicode paths, I assume it can handle UNC too, but documentation says it might be removed.

user4039065 · Accepted Answer · 2015-09-09 08:43:53Z

0

The MkDir command is only going to create a single new level of subdirectory.

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

answered Sep 9, 2015 at 8:43

user4039065

2 Comments

user4039065 Over a year ago

You mean the 60-odd Excel Tag points I lost recently on my route to a gold badge? Sure.

user4039065 Over a year ago

Sorry but I'm just not smart enough to find a room by that moniker.

Collectives™ on Stack Overflow

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

3 Answers 3

Comments

2 Comments

2 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

Comments

2 Comments

2 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related