PDA

View Full Version : [SOLVED] Check for folder; create if it does not exist



CompuCat
04-20-2006, 04:33 PM
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

BlueDNA
04-20-2006, 04:44 PM
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

:hi:

Justinlabenne
04-20-2006, 05:15 PM
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.



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

Killian
04-21-2006, 02:28 AM
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

Bob Phillips
04-21-2006, 03:19 AM
Why bother checking, just create it with error handling


On Error Resume Next
MkDir directoryname
On Error Goto 0

geekgirlau
04-21-2006, 04:29 AM
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.:clever:

By the way, welcome to the Board CompuCat!

Norie
04-21-2006, 07:19 AM
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

Anne Troy
12-22-2013, 06:38 PM
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.

snb
12-23-2013, 01:02 AM
After almost 8 years ???

Anne Troy
01-18-2014, 01:48 PM
I built it. You joined a year ago. LOL

Poduska
11-03-2016, 07:36 PM
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

Harry S
04-02-2017, 01:48 PM
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

snb
04-03-2017, 01:03 AM
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

Harry S
04-03-2017, 02:32 PM
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

Paul M
06-24-2017, 09:34 AM
Hello all :hi:

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

Thanks all

theenduknow
02-07-2018, 01:50 AM
Thanks all .
This post save me in 2018 :hi:

Johan90
05-01-2018, 07:27 AM
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

Riicci
11-16-2018, 12:47 AM
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


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

syzygy2112
06-23-2020, 07:16 AM
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 (https://dhexcel1.wordpress.com/2017/06/19/excel-short-and-sweet-tip-23-open-windows-file-explorer-with-worksheet-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