Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code to create folder and subfolders
Hi all,
Does anyone have code that can create parent folders automatically (if they don't exist)? For example I use MkDir to create folders. Currently I am doing it this way: MkDir FolderA MkDir FolderA\FolderB MkDir FolderA\FolderB\FolderC to create FolderC Is there a way to just write in the lowest subfolder (FolderA\FolderB \FolderC) and Excel/VBA would create the parent folders on its own, if they don't exist? Thx! --JP |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code to create folder and subfolders
Hi JP,
You can try : Private Declare Function MakeSureDirectoryPathExists _ Lib "imagehlp.dll" (ByVal lpPath As String) As Boolean Sub CreateDirectoryStructure() On Error GoTo 1 MakeSureDirectoryPathExists "C:\FolderA\FolderB\FolderC\FolderD\" Exit Sub 1: MsgBox "Error " & Err.Number & vbLf & Err.Description, 64 End Sub Regards, MP "JP" a écrit dans le message de news: ... Hi all, Does anyone have code that can create parent folders automatically (if they don't exist)? For example I use MkDir to create folders. Currently I am doing it this way: MkDir FolderA MkDir FolderA\FolderB MkDir FolderA\FolderB\FolderC to create FolderC Is there a way to just write in the lowest subfolder (FolderA\FolderB \FolderC) and Excel/VBA would create the parent folders on its own, if they don't exist? Thx! --JP |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code to create folder and subfolders
This will create a directory tree if it doenst exsist.
CheckDir is the important bit for you as this is the directory name you will be looking for I have set up an example. This should check if "C:\MatchBox\64\" exsists. If it doenst you will be prompted and then it wil create it Function CreateDir() Dim Fso Dim Answer Dim File Dim w As Long Dim TargetDir As Boolean Dim CheckDir As String TargetDir = False CheckDir = "C:\MatchBox\64\" File = CheckDir Set Fso = CreateObject("Scripting.FileSystemObject") 'Checks if the whole save directory exists, if it doesn't it finds out what is missing If Not Fso.folderexists(File) Then For w = 1 To Len(CheckDir) If Mid(CheckDir, w, 1) = "\" Then File = Mid(CheckDir, 1, w) Set Fso = CreateObject("Scripting.FileSystemObject") If Not Fso.folderexists(File) Then If TargetDir = False Then Answer = MsgBox("The save dir '" & CheckDir & "' does not exsit" & Chr(10) & Chr(10) & "Would you like to create it?", vbInformation + vbYesNo, "Save Directory Error") If Answer = vbYes Then TargetDir = True On Error GoTo errorhandler MkDir File Else Exit Function End If ElseIf TargetDir = True Then MkDir File End If End If End If Next w End If TargetDir = False errorhandler: If Err.Number 10 Then MsgBox "Cannot Create Dir!!!" End If End Function -- Message posted via OfficeKB.com http://www.officekb.com/Uwe/Forums.a...mming/200710/1 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code to create folder and subfolders
Thank you, I modified your code as follows. It's a bit awkward with
all of the IF statements, but it gets the job done. However, at my office we use UNC paths which means the first pass causes the macro to see every CheckDir variable as non-existent. Is there a way to account for the initial double-slash? Sub CreateDir() Dim Fso As Scripting.FileSystemObject Dim sFolder As String Dim w As Long Dim TargetDir As Boolean Dim CheckDir As String TargetDir = False CheckDir = "\\p111filclu01\Drug\RANDOMS\NewClient\2007\DO T\" sFolder = CheckDir Set Fso = CreateObject("Scripting.FileSystemObject") 'Checks if the whole save directory exists, if it doesn't it finds out what is missing If Not Fso.folderexists(sFolder) Then For w = 1 To Len(CheckDir) If Mid(CheckDir, w, 1) = "\" Then If w 1 Then If Mid(CheckDir, w - 1, 2) < "\\" Then sFolder = Mid(CheckDir, 1, w) If Not Mid(sFolder, w, 2) = "\\" Then If Not Fso.folderexists(sFolder) Then If TargetDir = False Then Select Case MsgBox("The directory '" & CheckDir & "' does not exist" & vbCrLf & vbCrLf & "Would you like to create it, along with with its parent folders?", vbYesNo) Case vbYes TargetDir = True On Error GoTo errorhandler MkDir sFolder Case Else Exit Sub End Select ElseIf TargetDir = True Then MkDir sFolder End If End If End If End If End If End If Next w End If TargetDir = False Exit Sub errorhandler: If Err.Number 10 Then MsgBox "Cannot Create Dir!!!" End If End Sub On Oct 16, 1:47 pm, "Crowbar via OfficeKB.com" <u15117@uwe wrote: This will create a directory tree if it doenst exsist. CheckDir is the important bit for you as this is the directory name you will be looking for I have set up an example. This should check if "C:\MatchBox\64\" exsists. If it doenst you will be prompted and then it wil create it |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code to create folder and subfolders
Hey I thought you might like to know I found this code on Chip
Pearson's website, should do what I am looking for so I'm posting the link. http://www.cpearson.com/excel/MakeDirMulti.htm Thx, JP On Oct 16, 1:47 pm, "Crowbar via OfficeKB.com" <u15117@uwe wrote: This will create a directory tree if it doenst exsist. CheckDir is the important bit for you as this is the directory name you will be looking for I have set up an example. This should check if "C:\MatchBox\64\" exsists. If it doenst you will be prompted and then it wil create it Function CreateDir() Dim Fso Dim Answer Dim File Dim w As Long Dim TargetDir As Boolean Dim CheckDir As String TargetDir = False CheckDir = "C:\MatchBox\64\" File = CheckDir Set Fso = CreateObject("Scripting.FileSystemObject") 'Checks if the whole save directory exists, if it doesn't it finds out what is missing If Not Fso.folderexists(File) Then For w = 1 To Len(CheckDir) If Mid(CheckDir, w, 1) = "\" Then File = Mid(CheckDir, 1, w) Set Fso = CreateObject("Scripting.FileSystemObject") If Not Fso.folderexists(File) Then If TargetDir = False Then Answer = MsgBox("The save dir '" & CheckDir & "' does not exsit" & Chr(10) & Chr(10) & "Would you like to create it?", vbInformation + vbYesNo, "Save Directory Error") If Answer = vbYes Then TargetDir = True On Error GoTo errorhandler MkDir File Else Exit Function End If ElseIf TargetDir = True Then MkDir File End If End If End If Next w End If TargetDir = False errorhandler: If Err.Number 10 Then MsgBox "Cannot Create Dir!!!" End If End Function -- Message posted via OfficeKB.comhttp://www.officekb.com/Uwe/Forums.aspx/excel-programming/200710/1 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
run macro on all closed workbooks in folder and subfolders | Excel Programming | |||
How to List the names of the subfolders present in the folder (path of folder is given in the textbox by user ) | Excel Programming | |||
How to decide folder-depth or How to select more folders/subfolders (folder-tree) ? | Excel Discussion (Misc queries) | |||
please help me with folder and subfolders | Excel Programming | |||
Create subfolders in a folder | Excel Programming |