MkDir question

  • Thread starter Thread starter Jim G
  • Start date Start date
J

Jim G

The following macro works and will eventurally be used in a Workbook Close
event. My question is why do I need to use MkDir twice to create a
subdirectory as C:\SubDir1\SubDir2. Is there an easier way to do this?

Private Sub TestSave()
'-----create a Backup

Dim BUpath1 As String
Dim BUpath2 As String
Dim BUname As String

BUpath1 = "C:\Invoices"
BUpath2 = "C:\Invoices\BackUp"
BUname = "Sub-Contract Invoice BACKUP TEST " & Format(Now, "dd-mmm-yy
h-mm-ss")

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Worksheets("Start").Activate
ThisWorkbook.Save

On Error Resume Next
If Dir(BUpath2) = "" Then
MkDir (BUpath1)
MkDir (BUpath2)
ActiveWorkbook.SaveCopyAs BUpath2 & "\" & BUname

MsgBox "A copy of the file has been saved as: " & BUpath & "\" & BUname
End If

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub
 
You have to create the directories in layers, you cannot create the child
until the parent exists.

I do it like this

Private Sub TestSave()
'-----create a Backup

Dim BUpath As String
Dim BUname As String

BUpath = "C:\Invoices\BackUp"
BUname = "Sub-Contract Invoice BACKUP TEST " & Format(Now, "dd-mmm-yy
h-mm-ss")

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Worksheets("Start").Activate
ThisWorkbook.Save

On Error Resume Next
If Dir(BUpath) = "" Then
MakeDir BUpath
ActiveWorkbook.SaveCopyAs BUpath & "\" & BUname

MsgBox "A copy of the file has been saved as: " & BUpath & "\" & BUname
End If

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub

Private Function MakeDir(Path As String)
Dim aryDirs As Variant
Dim partPath As String
Dim i As Long

aryDirs = Split(Path, Application.PathSeparator)
partPath = aryDirs(LBound(aryDirs))
On Error Resume Next
For i = LBound(aryDirs) + 1 To UBound(aryDirs)

partPath = partPath & Application.PathSeparator & aryDirs(i)
MkDir partPath
Next i
End Function
 
Sheer genius! I can almost understand it as well.

I'll make good use of this.

Thanks Bob
 
Try this code (use standard module) Declare Function must be at top of module.

Declare Function MakePath Lib "imagehlp.dll" Alias _
"MakeSureDirectoryPathExists" (ByVal lpPath As
String) As Long

Sub CreatePath()
MakeDir "C:\Invoices\Invoices\BackUp"
End Sub

Sub MakeDir(DirPath As String)

If Right(DirPath, 1) <> "\" Then DirPath = DirPath & "\"

MakePath DirPath

End Sub
 
Perfectly simple, thanks John
--
Jim


john said:
Try this code (use standard module) Declare Function must be at top of module.

Declare Function MakePath Lib "imagehlp.dll" Alias _
"MakeSureDirectoryPathExists" (ByVal lpPath As
String) As Long

Sub CreatePath()
MakeDir "C:\Invoices\Invoices\BackUp"
End Sub

Sub MakeDir(DirPath As String)

If Right(DirPath, 1) <> "\" Then DirPath = DirPath & "\"

MakePath DirPath

End Sub
Click to expand...
 
Back
Top