Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations John Tel on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
How to create folder with VBA 6
- Thread starter SkyHigh
- Start date
-
2
- #2
Hi Brenda,
This little routine checks for the Folder set at strFolder (c:\my documents\xxxx), strFolder can = Text/List/Combo Box or Common Dialog Control etc.
If the Folder exists lets you know, if not attempts to create the Folder, then lets you know if the Folder has been created or not.
On Error Resume Next
Dim fs, cf, strFolder
strFolder = "c:\my documents\xxxx"
Set fs = CreateObject("Scripting.FileSystemObject"
If fs.FolderExists(strFolder) = True Then
MsgBox "'" & strFolder & "' already exists!"
Else
Set cf = fs.CreateFolder(strFolder)
If fs.FolderExists(strFolder) = True Then
MsgBox "'" & strFolder & "' successfully created!"
Else
MsgBox "'" & strFolder & "' was not successfully created!"
End If
End If
This little routine checks for the Folder set at strFolder (c:\my documents\xxxx), strFolder can = Text/List/Combo Box or Common Dialog Control etc.
If the Folder exists lets you know, if not attempts to create the Folder, then lets you know if the Folder has been created or not.
On Error Resume Next
Dim fs, cf, strFolder
strFolder = "c:\my documents\xxxx"
Set fs = CreateObject("Scripting.FileSystemObject"
If fs.FolderExists(strFolder) = True Then
MsgBox "'" & strFolder & "' already exists!"
Else
Set cf = fs.CreateFolder(strFolder)
If fs.FolderExists(strFolder) = True Then
MsgBox "'" & strFolder & "' successfully created!"
Else
MsgBox "'" & strFolder & "' was not successfully created!"
End If
End If
- Thread starter
- #4
Thanks Bill
Suppose I want to create various folders, one for each customer based on their ids in a table, how can I add this to your code above, how about the following, would it work correctly :
On Error Resume Next
Dim fs, cf, strFolder
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT id FROM customer", dbOpenDynaset, dbReadOnly)
While Not rs.EOF
strFolder = "c:\customer\billing\" & rs!id
Set fs = CreateObject("Scripting.FileSystemObject"
If fs.FolderExists(strFolder) = True Then
MsgBox "'" & strFolder & "' already exists!"
Else
Set cf = fs.CreateFolder(strFolder)
If fs.FolderExists(strFolder) = True Then
MsgBox "'" & strFolder & "' successfully created!"
Else
MsgBox "'" & strFolder & "' was not successfully created!"
End If
End If
rs.MoveNext
Wend
Thanks
Brenda
Suppose I want to create various folders, one for each customer based on their ids in a table, how can I add this to your code above, how about the following, would it work correctly :
On Error Resume Next
Dim fs, cf, strFolder
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT id FROM customer", dbOpenDynaset, dbReadOnly)
While Not rs.EOF
strFolder = "c:\customer\billing\" & rs!id
Set fs = CreateObject("Scripting.FileSystemObject"
If fs.FolderExists(strFolder) = True Then
MsgBox "'" & strFolder & "' already exists!"
Else
Set cf = fs.CreateFolder(strFolder)
If fs.FolderExists(strFolder) = True Then
MsgBox "'" & strFolder & "' successfully created!"
Else
MsgBox "'" & strFolder & "' was not successfully created!"
End If
End If
rs.MoveNext
Wend
Thanks
Brenda
- Thread starter
- #5
That's perfect, I've just added an Error Procedure in case there's a problem with the RS and moved the Resume Next to after the RS has been created.
Private Sub Command0_Click()
Dim fs, cf, strFolder
Dim db As DAO.Database
Dim rs As DAO.Recordset
On Error GoTo Err_CreateFolder
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT id FROM customer", dbOpenDynaset, dbReadOnly)
On Error Resume Next
While Not rs.EOF
strFolder = "c:\customer\billing\" & rs!id
Set fs = CreateObject("Scripting.FileSystemObject"
If fs.FolderExists(strFolder) = True Then
MsgBox "'" & strFolder & "' already exists!"
Else
Set cf = fs.CreateFolder(strFolder)
If fs.FolderExists(strFolder) = True Then
MsgBox "'" & strFolder & "' successfully created!"
Else
MsgBox "'" & strFolder & "' was not successfully created!"
End If
End If
rs.MoveNext
Wend
Err_CreateFolder:
MsgBox Err.Number & " " & Err.Description
End Sub
Good Luck
Bill
Private Sub Command0_Click()
Dim fs, cf, strFolder
Dim db As DAO.Database
Dim rs As DAO.Recordset
On Error GoTo Err_CreateFolder
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT id FROM customer", dbOpenDynaset, dbReadOnly)
On Error Resume Next
While Not rs.EOF
strFolder = "c:\customer\billing\" & rs!id
Set fs = CreateObject("Scripting.FileSystemObject"
If fs.FolderExists(strFolder) = True Then
MsgBox "'" & strFolder & "' already exists!"
Else
Set cf = fs.CreateFolder(strFolder)
If fs.FolderExists(strFolder) = True Then
MsgBox "'" & strFolder & "' successfully created!"
Else
MsgBox "'" & strFolder & "' was not successfully created!"
End If
End If
rs.MoveNext
Wend
Err_CreateFolder:
MsgBox Err.Number & " " & Err.Description
End Sub
Good Luck
Bill
- Thread starter
- #7
I am still getting error 76 with description as "path not found" however if I first create the base directories one by one like c:\customer and then c:\customer\billing then it seems to work from there on and creates the customer directories without complaints.
Thanks for your help
Brenda
Thanks for your help
Brenda
Hi,
What was a little routine is now quite a big one. CreateFolder as we've now both learned just creates a Folder as its name suggests, not a Path. So I've added code that should create a Path to the Folders you want to create with your Recordset (if it doesn't exist). The Path(strFolder) can go as deep as Windows allows, but must not end in "\".
Dim intCurrPos As Integer, intNextPos As Integer, intLength As Integer
Dim strSlash As String, strFolder As String, strRSFolder As String
Dim fs, cf, x
Dim db As DAO.Database
Dim rs As DAO.Recordset
On Error GoTo Err_CreateFolder
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT ID FROM Customer", dbOpenDynaset, dbReadOnly)
On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject"
strSlash = "\"
intCurrPos = 4
strFolder = "c:\customer\billing"
intLength = Len(strFolder)
If intLength > 3 Then
Do
intNextPos = InStr(intCurrPos, strFolder, strSlash)
intCurrPos = intNextPos + 1
If intNextPos > 0 Then
If fs.FolderExists(Left(strFolder, intNextPos - 1)) = False Then
Set cf = fs.CreateFolder(Left(strFolder, intNextPos - 1))
End If
Else
If fs.FolderExists(Left(strFolder, intLength)) = False Then
Set cf = fs.CreateFolder(Left(strFolder, intLength))
End If
End If
Loop Until (intNextPos = 0)
End If
While Not rs.EOF
strRSFolder = strFolder & "\" & rs!id
Set fs = CreateObject("Scripting.FileSystemObject"
If fs.FolderExists(strRSFolder) = True Then
MsgBox "'" & strRSFolder & "' already exists!"
Else
Set cf = fs.CreateFolder(strRSFolder) & "\"
If fs.FolderExists(strRSFolder) = True Then
MsgBox "'" & strRSFolder & "' successfully created!"
Else
MsgBox "'" & strRSFolder & "' was not successfully created!"
End If
End If
rs.MoveNext
Wend
Exit Sub
Err_CreateFolder:
MsgBox Err.Number & " " & Err.Description
Let me know how you get on, you haven't in previous Threads.
Bill
What was a little routine is now quite a big one. CreateFolder as we've now both learned just creates a Folder as its name suggests, not a Path. So I've added code that should create a Path to the Folders you want to create with your Recordset (if it doesn't exist). The Path(strFolder) can go as deep as Windows allows, but must not end in "\".
Dim intCurrPos As Integer, intNextPos As Integer, intLength As Integer
Dim strSlash As String, strFolder As String, strRSFolder As String
Dim fs, cf, x
Dim db As DAO.Database
Dim rs As DAO.Recordset
On Error GoTo Err_CreateFolder
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT ID FROM Customer", dbOpenDynaset, dbReadOnly)
On Error Resume Next
Set fs = CreateObject("Scripting.FileSystemObject"
strSlash = "\"
intCurrPos = 4
strFolder = "c:\customer\billing"
intLength = Len(strFolder)
If intLength > 3 Then
Do
intNextPos = InStr(intCurrPos, strFolder, strSlash)
intCurrPos = intNextPos + 1
If intNextPos > 0 Then
If fs.FolderExists(Left(strFolder, intNextPos - 1)) = False Then
Set cf = fs.CreateFolder(Left(strFolder, intNextPos - 1))
End If
Else
If fs.FolderExists(Left(strFolder, intLength)) = False Then
Set cf = fs.CreateFolder(Left(strFolder, intLength))
End If
End If
Loop Until (intNextPos = 0)
End If
While Not rs.EOF
strRSFolder = strFolder & "\" & rs!id
Set fs = CreateObject("Scripting.FileSystemObject"
If fs.FolderExists(strRSFolder) = True Then
MsgBox "'" & strRSFolder & "' already exists!"
Else
Set cf = fs.CreateFolder(strRSFolder) & "\"
If fs.FolderExists(strRSFolder) = True Then
MsgBox "'" & strRSFolder & "' successfully created!"
Else
MsgBox "'" & strRSFolder & "' was not successfully created!"
End If
End If
rs.MoveNext
Wend
Exit Sub
Err_CreateFolder:
MsgBox Err.Number & " " & Err.Description
Let me know how you get on, you haven't in previous Threads.
Bill
- Thread starter
- #9
![[bigglasses]](/data/assets/smilies/bigglasses.gif "[bigglasses] [bigglasses]")
Thanks Nathan,
Believe me I appreciate the star, hopefully this Thread won't disappear so quickly and be read by more Members now. This started as what I thought would be 15/20 minute solution, but turned into an all nighter, so Thanks again.
Bill
Believe me I appreciate the star, hopefully this Thread won't disappear so quickly and be read by more Members now. This started as what I thought would be 15/20 minute solution, but turned into an all nighter, so Thanks again.
Bill
-
3
- #12
I wouldn't use FSO when Dir and MkDir are available.
The function below checks if the directory strDir exists and if not, creates it. Returns False if directory was there, True if newly created.
'*******************************************
Function CheckAndCreateDir(strDir As String) As Boolean
If Dir(strDir, vbDirectory) = "" Then
MkDir strDir
CheckAndCreateDir = True
MsgBox "I did my job-folder created"
Else
MsgBox "Hey! That directory exists! Don't waste my time!"
End If
End Function
'********************************************
Delete the msgbox lines.
Just another way to skin this cat...
![[pipe]](/data/assets/smilies/pipe.gif "[pipe] [pipe]")
Daniel Vlas
Systems Consultant
The function below checks if the directory strDir exists and if not, creates it. Returns False if directory was there, True if newly created.
'*******************************************
Function CheckAndCreateDir(strDir As String) As Boolean
If Dir(strDir, vbDirectory) = "" Then
MkDir strDir
CheckAndCreateDir = True
MsgBox "I did my job-folder created"
Else
MsgBox "Hey! That directory exists! Don't waste my time!"
End If
End Function
'********************************************
Delete the msgbox lines.
Just another way to skin this cat...
Daniel Vlas
Systems Consultant
Danvlas,
No, No, No. FSO is a far more valuable method to pass on to the Members that are learning in this Forum. FSO is a dedicated set of Methods as the name FileSystemObject suggests, for managing Files and Folders on your PC and Network through Access. Yes, I could have used Dir and MKDir, but that's pretty old hat. Incidentally, the example you have given, in terms of coding, FSO uses the same amount of lines of code to do that.
Anyway, I'm not going to go on defending my use of FSO, I hope anyone reading this will do a search in Help on FileSystemObject to discover it's versatility and range of Methods available.
Finally, I think you lost the plot on this Thread, the time consuming part of this was for me e.g. if the "customer" and or "billing" folder in "c:\customer\billing" didn't exist was how to create it. Using Dir and MKDir would have not taken any less time in coming up with the solution. If "c:\customer\billing" doesn't exist, MKDir will raise an Error "path doesn't exist". You'd still have to do what I did.
Bill Power
No, No, No. FSO is a far more valuable method to pass on to the Members that are learning in this Forum. FSO is a dedicated set of Methods as the name FileSystemObject suggests, for managing Files and Folders on your PC and Network through Access. Yes, I could have used Dir and MKDir, but that's pretty old hat. Incidentally, the example you have given, in terms of coding, FSO uses the same amount of lines of code to do that.
Anyway, I'm not going to go on defending my use of FSO, I hope anyone reading this will do a search in Help on FileSystemObject to discover it's versatility and range of Methods available.
Finally, I think you lost the plot on this Thread, the time consuming part of this was for me e.g. if the "customer" and or "billing" folder in "c:\customer\billing" didn't exist was how to create it. Using Dir and MKDir would have not taken any less time in coming up with the solution. If "c:\customer\billing" doesn't exist, MKDir will raise an Error "path doesn't exist". You'd still have to do what I did.
Bill Power
Yes Bill, you're right.
One question though...
Why don't you Set fs = Nothing when done? Relying on Access to do that when the procedure is over? I never do that!
I just said it was another way to skin the same cat...
And my personal preference is to use object variables only when I have no other choice... And one of the reasons is that such variables sometimes are not cleared unless specifically instructed - I pulled some of my hair trying to find out why Access wouldn't quit even though the database was closed, leaving me no other choice than to Ctrl+Alt+Del...so I learnt my lesson.
And - by the way - the same happens sometimes if you start a transaction and do not CommitTrans or Rollback. I know, it should Rollback. But it doesn't always and I have no reasonable explanation
They are old hat, you're right, but I would say 'Oldies but goldies'.
![[thumbsup]](/data/assets/smilies/thumbsup.gif "[thumbsup] [thumbsup]")
Daniel Vlas
Systems Consultant
One question though...
Why don't you Set fs = Nothing when done? Relying on Access to do that when the procedure is over? I never do that!
I just said it was another way to skin the same cat...
And my personal preference is to use object variables only when I have no other choice... And one of the reasons is that such variables sometimes are not cleared unless specifically instructed - I pulled some of my hair trying to find out why Access wouldn't quit even though the database was closed, leaving me no other choice than to Ctrl+Alt+Del...so I learnt my lesson.
And - by the way - the same happens sometimes if you start a transaction and do not CommitTrans or Rollback. I know, it should Rollback. But it doesn't always and I have no reasonable explanation
They are old hat, you're right, but I would say 'Oldies but goldies'.
Daniel Vlas
Systems Consultant
- Thread starter
- #15
Bill, I didn't mean to step on your (or anybody's) toes.
A preference is a just a preference, with its pros and cons.
I have nothing against FSO and it does its job just fine when Windows Scripting Host is enabled. But some users disable it, because of virus threat, and the FSO is then just dead meat-CreateObject fails.
I reviewed the code and here is a function that checks and creates the entire chain from sctratch or just the subdirectories that do not exist. The function output is the number of subdirectories created within the chain.
Not passing a drive or \\sharename will result in creation of the chain in the current directory.
The code is 17 lines long (except declarations and comments)...
Function fCheckDirs(strDir As String) As Integer
'***************************************************
'Purpose: To check/create directories
'Input: Path upto the final directory
'Output: number of directories created
'May 19, 2003
'Tek-Tips thread705-550174
'Daniel Vlas
'***************************************************
Dim strDirectory As String
Dim strRoot As String 'C:\, D:\, \\ShareName\
Dim i As Integer
'detect root
If Left(strDir, 1) = "\" Then 'UNC, starts with \'----------------------------------------------------------
'Extract root of UNC path
strRoot = Right(strDir, Len(strDir) - 2)
If InStr(strRoot, "\" > 0 Then
strRoot = "\\" & Left(strRoot, InStr(strRoot, "\")
End If
'---------------------------------------------------------
Else
'---------------------------------------------------------
'Just take the drive letter + :
strRoot = Left(strDir, 2)
'----------------------------------------------------------
End If
'-----------------------------------------------------------
'Remove the root from the path-it should NOT be created!
strDirectory = Right(strDir, Len(strDir) - Len(strRoot))
'-----------------------------------------------------------
'-----------------------------------------------------------
'Start looping throug the characters in the path
For i = 1 To Len(strDirectory)
'-----------------------------------------------------------
'--------------------------------------------------------------------
'Subdirectory found or final path
If Mid(strDirectory, i + 1, 1) = "\" Or i = Len(strDirectory) Then
'----------------------------------------------------------
'-------------------------------------------------------
'If subdirectory does not exist, create it and increment function output
If Dir(strRoot & Left(strDirectory, i), vbDirectory) = "" Then
MkDir (strRoot & Left(strDirectory, i))
fCheckDirs = fCheckDirs + 1
'------------------------------------------------------
End If
End If
'-----------------------------
'Move to next character
Next
'-----------------------------
End Function
Good luck
Daniel Vlas
Systems Consultant
A preference is a just a preference, with its pros and cons.
I have nothing against FSO and it does its job just fine when Windows Scripting Host is enabled. But some users disable it, because of virus threat, and the FSO is then just dead meat-CreateObject fails.
I reviewed the code and here is a function that checks and creates the entire chain from sctratch or just the subdirectories that do not exist. The function output is the number of subdirectories created within the chain.
Not passing a drive or \\sharename will result in creation of the chain in the current directory.
The code is 17 lines long (except declarations and comments)...
Function fCheckDirs(strDir As String) As Integer
'***************************************************
'Purpose: To check/create directories
'Input: Path upto the final directory
'Output: number of directories created
'May 19, 2003
'Tek-Tips thread705-550174
'Daniel Vlas
'***************************************************
Dim strDirectory As String
Dim strRoot As String 'C:\, D:\, \\ShareName\
Dim i As Integer
'detect root
If Left(strDir, 1) = "\" Then 'UNC, starts with \'----------------------------------------------------------
'Extract root of UNC path
strRoot = Right(strDir, Len(strDir) - 2)
If InStr(strRoot, "\"
> 0 ThenstrRoot = "\\" & Left(strRoot, InStr(strRoot, "\"
)End If
'---------------------------------------------------------
Else
'---------------------------------------------------------
'Just take the drive letter + :
strRoot = Left(strDir, 2)
'----------------------------------------------------------
End If
'-----------------------------------------------------------
'Remove the root from the path-it should NOT be created!
strDirectory = Right(strDir, Len(strDir) - Len(strRoot))
'-----------------------------------------------------------
'-----------------------------------------------------------
'Start looping throug the characters in the path
For i = 1 To Len(strDirectory)
'-----------------------------------------------------------
'--------------------------------------------------------------------
'Subdirectory found or final path
If Mid(strDirectory, i + 1, 1) = "\" Or i = Len(strDirectory) Then
'----------------------------------------------------------
'-------------------------------------------------------
'If subdirectory does not exist, create it and increment function output
If Dir(strRoot & Left(strDirectory, i), vbDirectory) = "" Then
MkDir (strRoot & Left(strDirectory, i))
fCheckDirs = fCheckDirs + 1
'------------------------------------------------------
End If
End If
'-----------------------------
'Move to next character
Next
'-----------------------------
End Function
Good luck
Daniel Vlas
Systems Consultant
Hi danvlas,
Very good alternative to FSO, can't dish out another star as I have already done so.
No need to aplogise for making a different suggestion, it's good that Members do. I make suggestions here most days, but admit quite often another Member will come up with a better/more suitable answer than mine. To me that's great, I've learned a new or better technique and so possibly has the Forum.
I decided that I couldn't go any further with this Thread, the code works perfectly here at home, I got no reply from SkyHigh, so instead of just ignoring the Thread and leaving it in limbo asked if someone else could take it over, as I've seen other Members do.
So once again, well done for coming up with what appears a viable alternative to FSO.
All the best.
Bill
Very good alternative to FSO, can't dish out another star as I have already done so.
No need to aplogise for making a different suggestion, it's good that Members do. I make suggestions here most days, but admit quite often another Member will come up with a better/more suitable answer than mine. To me that's great, I've learned a new or better technique and so possibly has the Forum.
I decided that I couldn't go any further with this Thread, the code works perfectly here at home, I got no reply from SkyHigh, so instead of just ignoring the Thread and leaving it in limbo asked if someone else could take it over, as I've seen other Members do.
So once again, well done for coming up with what appears a viable alternative to FSO.
All the best.
Bill
- Thread starter
- #20
- Status
Similar threads
- Locked
- Question
- Locked
- Question