Help with Creating folders on Save

[Alarmbloke]

Hi,

Can any one help with this dilemma,

When clicking on a macro to save an excel file I need to create multiple
folders if they don't already exist, within the C directory,

IE C:\Folder1\Folder2\Folder3\Folder4\Folder5\filename.xls

Each Folder Name is allocated from a the contents of a Cell

IE Cell A1 = Folder 1
Cell A2 = Folder 2 etc

And the filename is also in a cell.

How do I get Excel to check if the folders exist and then create them if not
ready to save the final file in the new location??

Thanks

A puzzled excel student!!

 

[Dave Peterson]

One way:

Option Explicit
Sub testme01()
Dim wks As Worksheet
Dim myCell As Range
Dim myPath As String
Dim testStr As String

Set wks = Worksheets("sheet1")

myPath = "C:"
With wks
On Error Resume Next
For Each myCell In .Range("a1:a5").Cells
If myCell.Value = "" Then
MsgBox "Ummmmmmm. Fill in those cells!"
Exit Sub
End If
myPath = myPath & "\" & myCell.Value
MkDir myPath
Next myCell
On Error GoTo 0
End With

testStr = ""
On Error Resume Next
testStr = Dir(myPath) & "\nul"
On Error GoTo 0

If testStr = "" Then
MsgBox "Error finding/creating: " & myPath
Exit Sub
End If

'do the work

End Sub

===
Or you could use an API function call:

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

Sub testme02()
Dim myCell As Range
Dim myPath As String
Dim wks As Worksheet

Set wks = Worksheets("Sheet1")

With wks
For Each myCell In .Range("a1:a5").Cells
If myCell.Value = "" Then
MsgBox "Ummmmmmm. Fill in those cells!"
Exit Sub
End If
myPath = myPath & "\" & myCell.Value
MkDir myPath
Next myCell
End With

If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If
MakePath myPath
End Sub

 

[Alarmbloke]

Thanks again Dave.

Once again a perfect solution.

Must take a course on this Excel VBA lark, is there anything it wont do??
Wash the dishes, clean the car, keep the wife happy whilst I struggle away
with work???

 

[Dave Peterson]

I've never seen it shovel snow--but that might not be a problem where you live!