Consulting

Results 1 to 19 of 19

Thread: Check for folder; create if it does not exist

  1. #1
    VBAX Newbie
    Joined
    Apr 2006
    Posts
    1
    Location

    Check for folder; create if it does not exist

    Hi everyone. I'm new to VBA and new to this site.

    I need to automate a few tasks in a file, then saveas to a folder. I need to see if the folder exists. If not, create the folder. I have a start. Could someone please let me know how to accomplish this? I'm not sure what matters here... I'm using VBA in Excel 2003 on an XP Pro system.

    The folder should be in the root of C: and be called 'P2P User Folder' or something similar.

    Sub Master()
     '
     ' Master Macro
     ' Macro recorded 4/20/2006 by CompuCat
     '
     ' Keyboard Shortcut: Ctrl+m
     '
     Application.DisplayAlerts = False
         Rows("1:1").Select
         Range("F1").Activate
         Selection.Delete Shift:=xlUp
         Columns("P:P").Select
         Selection.Delete Shift:=xlToLeft
     [This is where I need to see if the folder exists, and then create it, if it does not]
         ChDir "C:\P2P User Folder"
         ActiveWorkbook.SaveAs Filename:= _
             "C:\P2P User Folder\newuser.csv" _
             , FileFormat:=xlCSV, CreateBackup:=False
         ActiveWorkbook.SaveAs Filename:= _
             "C:\P2P User Folder\chguser.csv" _
             , FileFormat:=xlCSV, CreateBackup:=False
     End Sub
    Thanks, and I appreciate any advice you have.

    CompuCat
    Last edited by Aussiebear; 11-18-2018 at 07:24 PM. Reason: added correct tags to posted code

  2. #2
    Hi,

    im quite new too. try this

    Public Sub createNewDirectory(directoryName As String)
    If Not DirExists(directoryName) Then 
    MkDir (directoryName)
    End If
    End Sub
     
    Function DirExists(DirName As String) As Boolean
    On Error GoTo ErrorHandler
    DirExists = GetAttr(DirName) And vbDirectory 
    ErrorHandler: 
    End Function
    hope this helps

    Last edited by Aussiebear; 11-18-2018 at 07:25 PM. Reason: Added correct tags to posted code

  3. #3
    VBAX Mentor Justinlabenne's Avatar
    Joined
    Jul 2004
    Location
    Clyde, Ohio
    Posts
    408
    Location
    This function checks a path to ensure it has a trailing path seperator, and that the path gets created if it doesn't exist. Two arguments to set, the path to the folder, then True if you want the folder created. I tried to implement it within your existing code, and it created a folder Named "P2P User Folder" on my C:\ drive, and saved 2 csv files into it. You may want to use SaveCopyAs instead of SaveAs depending on what your doing.


    [vba]
    Public Function fCheckPath(ByRef FolderPath As String, _
    Optional ByVal CreatePath As Boolean = False) As String
    Dim s() As String
    Dim d As String
    Dim i As Integer
    If CreatePath Then
    'If they supplied an ending path seperator, cut it for now
    If Right$(FolderPath, 1) = Chr(92) Then _
    FolderPath = Left$(FolderPath, Len(FolderPath) - 1)

    s = Split(FolderPath, Chr(92))

    d = s(0)
    For i = 1 To UBound(s)
    d = d & Chr(92) & s(i)
    If Len(Dir(d, vbDirectory)) = 0 Then MkDir d
    Next i
    End If

    If Not Right$(FolderPath, 1) = Chr(92) Then _
    fCheckPath = FolderPath & Chr(92): Exit Function
    fCheckPath = FolderPath
    End Function

    Sub Master()
    '
    ' Master Macro
    ' Macro recorded 4/20/2006 by CompuCat
    '
    ' Keyboard Shortcut: Ctrl+m
    '
    Dim szSavePath As String

    Application.DisplayAlerts = False
    Rows("1:1").Select
    Range("F1").Activate
    Selection.Delete Shift:=xlUp
    Columns("P:P").Select
    Selection.Delete Shift:=xlToLeft
    szSavePath = fCheckPath("C:\P2P User Folder", True)
    ActiveWorkbook.SaveAs Filename:= _
    szSavePath & "newuser.csv" _
    , FileFormat:=xlCSV, CreateBackup:=False
    ActiveWorkbook.SaveAs Filename:= _
    szSavePath & "chguser.csv" _
    , FileFormat:=xlCSV, CreateBackup:=False
    End Sub
    [/vba]
    Justin Labenne

  4. #4
    VBAX Master Killian's Avatar
    Joined
    Nov 2004
    Location
    London
    Posts
    1,132
    Location
    Another option would be to use the FileSystemObject
    Dim fso As Object
    Const FLDR_NAME As String = "C:\P2P User Folder\"
    
        Set fso = CreateObject("Scripting.FileSystemObject")
        
        If Not fso.FolderExists(FLDR_NAME) Then
            fso.CreateFolder (FLDR_NAME)
        End If
        
        'save the file
        ActiveWorkbook.SaveAs Filename:= _
        FLDR_NAME & "newuser.csv" _
        , FileFormat:=xlCSV, CreateBackup:=False
    K :-)

  5. #5
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    Why bother checking, just create it with error handling

    [vba]
    On Error Resume Next
    MkDir directoryname
    On Error Goto 0
    [/vba]

  6. #6
    Moderator VBAX Master geekgirlau's Avatar
    Joined
    Aug 2004
    Location
    Melbourne, Australia
    Posts
    1,464
    Location
    Don't you love VBA - there's always more than one way to skin a cat! I'm constantly finding that even though I know one (or two) methods to accomplish something, someone else can get the same result in half the amount of code.

    By the way, welcome to the Board CompuCat!

  7. #7
    VBAX Master Norie's Avatar
    Joined
    Jan 2005
    Location
    Stirling, Scotland
    Posts
    1,831
    Location
    Why not just use Dir?
    Sub TestForDir()
    Dim strDir As String
        strDir = "C:\My Documents\TestDir\"
        
        If Dir(strDir, vbDirectory) = "" Then
            MkDir strDir
        Else
            MsgBox "Directory exists."
        End If
    End Sub

  8. #8
    Site Admin
    The Princess
    VBAX Guru Anne Troy's Avatar
    Joined
    May 2004
    Location
    Arlington Heights, IL
    Posts
    2,530
    Location
    Quote Originally Posted by Norie View Post
    Why not just use Dir?
    Sub TestForDir()
    Dim strDir As String
        strDir = "C:\My Documents\TestDir\"
        
        If Dir(strDir, vbDirectory) = "" Then
            MkDir strDir
        Else
            MsgBox "Directory exists."
        End If
    End Sub
    Beautiful, Norie. As usual.
    ~Anne Troy

  9. #9
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    After almost 8 years ???

  10. #10
    Site Admin
    The Princess VBAX Guru Anne Troy's Avatar
    Joined
    May 2004
    Location
    Arlington Heights, IL
    Posts
    2,530
    Location
    I built it. You joined a year ago. LOL
    ~Anne Troy

  11. #11
    VBAX Newbie
    Joined
    Sep 2009
    Posts
    1
    Location
    WOW over 10 year old post!!!!!!
    I am trying xld's error method but bookmarking the post.
    BTW, my best practice is always to copy address bar and post in as comment in code!
    Thanks

  12. #12
    VBAX Newbie
    Joined
    Dec 2016
    Location
    Toowoomba Qld Aus
    Posts
    2
    Location
    Often you need sub directories like F:\fred\jim\bert\helpa1\ and so far only F:\fred\jim\ exist
    good old Fso and error checking I do not like ??? so
    Sub MakeAllPath(ByVal PS$)
        Dim PP$
        If PS <> "" Then
            ' chop any end  name
            PP = Left(PS, InStrRev(PS, "\") - 1)
            ' if not there so build it
            If Dir(PP, vbDirectory) = "" Then
                MakeAllPath Left(PP, InStrRev(PS, "\") - 1)
                ' if not back to drive then  build on what is there
                If Right(PP, 1) <> ":" Then MkDir PP
            End If
        End If
    End Sub
    Hopefully the Drive exists

  13. #13
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    Although using fso is the best option, in using mkdir I'd use:

    Sub M_snb()
       sn = Split("F:\fred\jim\bert\helpa1\", "\")
       j = 1
       c00 = sn(0) & "\" & sn(j)
       
       Do Until Dir(c00, 16) <> ""
        MkDir c00
        j = j + 1
        c00 = c00 & "\" & sn(j)
       Loop
    End Sub

  14. #14
    VBAX Newbie
    Joined
    Dec 2016
    Location
    Toowoomba Qld Aus
    Posts
    2
    Location
    does M_Snb build the others of an existing directory


    RmDir "F:\fred\jim\bert\helpa1\"
    RmDir "F:\fred\jim\bert\"
    ' RmDir "F:\fred\jim\"

    then no helpal directory is built ????? as fred has subdir jim

  15. #15
    VBAX Newbie
    Joined
    Jun 2017
    Posts
    1
    Location
    Hello all

    Eleven years since it was originally posted and I found this thread very helpful

    Thanks all

  16. #16
    Thanks all .
    This post save me in 2018

  17. #17
    VBAX Regular
    Joined
    May 2018
    Posts
    14
    Location
    I have similar question, I need to create folder structures and have made this code that does almost everything I need. The problem arise when the code tries to create a folder that has a non valid path to it (meaning that there is a folder before it that is missing).

    So far I have seen two problems that might arise when I use this code, the folder already exist or the path is missing a part in it.

    I want to the code to move through the entire structure and create all folders, so when there already is a existing folder or a folder link is needed I want a message box to promt the issue and what folder is missing. (preferably I would like a yes/no question if I want to create the missing folder but that is just a bonus).


    I have tried using On error goto but cant really get it to work as I am not that familiar with error trapping/handling since before now I have always built macros for personal use and because of that I could always just error handle myself as it happens.



    Sub MakeSelectionDir2()
    
    Application.ScreenUpdating = False
    
    
    On Error GoTo ErrHand
    
    
    Range("C10").Select
    
    
    
    Do Until ActiveCell.Value = "STOP"
    
    
    dir2 = ActiveCell.Offset(0, 1)
    
    
    
    
        If Len(Dir(dir2, vbDirectory)) > 0 Then
        
     
           MsgBox "(" & dir2 & ") Folder already exist"
        
           
           Else
           
    
             MkDir dir2
             
             
             
        End If
        
        
         ActiveCell.Offset(1, 0).Range("A1").Select
             
        
    Loop
    
    
    
    
    Application.ScreenUpdating = True
    
    
    Range("D10").Select
    
    
    End Sub

  18. #18
    VBAX Newbie
    Joined
    Nov 2018
    Posts
    1
    Location

    Same problem

    I had the same problem. I figured I could use Nories old and clean code, then extend it a little bit. Here is my solution:
    Sub TestForDir()
    Dim strDir As String, tmpDir As String, TestChr As String, DirTest As String
    Dim Counter As Integer
    strDir = "C:\Users\XXX\Desktop\TestFolder\TestTwo"

    For Counter = 1 To Len(strDir)
    tmpDir = Left(strDir, Counter - 1)
    TestChr = Mid(strDir, Counter, 1)
    DirTest = Dir(tmpDir, vbDirectory)

    If DirTest = "" And TestChr = "" Then
    MkDir tmpDir
    MsgBox "Created:" & tmpDir
    End If
    Next Counter
    End Sub

    Quote Originally Posted by Johan90 View Post
    I have similar question, I need to create folder structures and have made this code that does almost everything I need. The problem arise when the code tries to create a folder that has a non valid path to it (meaning that there is a folder before it that is missing).

    So far I have seen two problems that might arise when I use this code, the folder already exist or the path is missing a part in it.

    I want to the code to move through the entire structure and create all folders, so when there already is a existing folder or a folder link is needed I want a message box to promt the issue and what folder is missing. (preferably I would like a yes/no question if I want to create the missing folder but that is just a bonus).


    I have tried using On error goto but cant really get it to work as I am not that familiar with error trapping/handling since before now I have always built macros for personal use and because of that I could always just error handle myself as it happens.



    Sub MakeSelectionDir2()
    
    Application.ScreenUpdating = False
    
    
    On Error GoTo ErrHand
    
    
    Range("C10").Select
    
    
    
    Do Until ActiveCell.Value = "STOP"
    
    
    dir2 = ActiveCell.Offset(0, 1)
    
    
    
    
        If Len(Dir(dir2, vbDirectory)) > 0 Then
        
     
           MsgBox "(" & dir2 & ") Folder already exist"
        
           
           Else
           
    
             MkDir dir2
             
             
             
        End If
        
        
         ActiveCell.Offset(1, 0).Range("A1").Select
             
        
    Loop
    
    
    
    
    Application.ScreenUpdating = True
    
    
    Range("D10").Select
    
    
    End Sub

  19. #19
    Quote Originally Posted by Norie View Post
    Why not just use Dir?
    Sub TestForDir()
    Dim strDir As String
        strDir = "C:\My Documents\TestDir\"
        
        If Dir(strDir, vbDirectory) = "" Then
            MkDir strDir
        Else
            MsgBox "Directory exists."
        End If
    End Sub
    Thank you so much for this elegant code! I registered just to reply because it has been SO helpful -- It has helped me extend a UDF by David Hager to test for specified path and add it if needed, all before opening said directory!

    For those interested, here's how my code looks in combination with David Hager's.

    Function ValidateHyperlink(Optional vFolderPath As String = "C:\")
    
    
    'Trigger with changed value in another cell with this wording: "=B1&FollowHyperlink()"
    
    
        'Code tests to see if the path exists.  If not, it makes the directory before opening it.  If it does, it opens it.
    Dim strDir As String
        strDir = vFolderPath
        
        If Dir(strDir, vbDirectory) = "" Then
            MkDir strDir
        'Else
         '   MsgBox "Directory exists."
        End If
    
    
    On Error Resume Next
        ThisWorkbook.FollowHyperlink [vFolderPath]
    
    
    End Function

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •