close

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\filenam e.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!!

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(quot;sheet1quot;)

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

testStr = quot;quot;
On Error Resume Next
testStr = Dir(myPath) amp; quot;\nulquot;
On Error GoTo 0

If testStr = quot;quot; Then
MsgBox quot;Error finding/creating: quot; amp; myPath
Exit Sub
End If

'do the work

End Sub

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

Option Explicit
Declare Function MakePath Lib quot;imagehlp.dllquot; Alias _
quot;MakeSureDirectoryPathExistsquot; (ByVal lpPath As String) As Long

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

Set wks = Worksheets(quot;Sheet1quot;)

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

If Right(myPath, 1) lt;gt; quot;\quot; Then
myPath = myPath amp; quot;\quot;
End If
MakePath myPath
End SubAlarmbloke wrote:
gt;
gt; Hi,
gt;
gt; Can any one help with this dilemma,
gt;
gt; When clicking on a macro to save an excel file I need to create multiple
gt; folders if they don't already exist, within the C directory,
gt;
gt; IE C:\Folder1\Folder2\Folder3\Folder4\Folder5\filenam e.xls
gt;
gt; Each Folder Name is allocated from a the contents of a Cell
gt;
gt; IE Cell A1 = Folder 1
gt; Cell A2 = Folder 2 etc
gt;
gt; And the filename is also in a cell.
gt;
gt; How do I get Excel to check if the folders exist and then create them if not
gt; ready to save the final file in the new location??
gt;
gt; Thanks
gt;
gt; A puzzled excel student!!

--

Dave Peterson

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???

quot;Dave Petersonquot; wrote:

gt; One way:
gt;
gt; Option Explicit
gt; Sub testme01()
gt; Dim wks As Worksheet
gt; Dim myCell As Range
gt; Dim myPath As String
gt; Dim testStr As String
gt;
gt; Set wks = Worksheets(quot;sheet1quot;)
gt;
gt; myPath = quot;C:quot;
gt; With wks
gt; On Error Resume Next
gt; For Each myCell In .Range(quot;a1:a5quot;).Cells
gt; If myCell.Value = quot;quot; Then
gt; MsgBox quot;Ummmmmmm. Fill in those cells!quot;
gt; Exit Sub
gt; End If
gt; myPath = myPath amp; quot;\quot; amp; myCell.Value
gt; MkDir myPath
gt; Next myCell
gt; On Error GoTo 0
gt; End With
gt;
gt; testStr = quot;quot;
gt; On Error Resume Next
gt; testStr = Dir(myPath) amp; quot;\nulquot;
gt; On Error GoTo 0
gt;
gt; If testStr = quot;quot; Then
gt; MsgBox quot;Error finding/creating: quot; amp; myPath
gt; Exit Sub
gt; End If
gt;
gt; 'do the work
gt;
gt; End Sub
gt;
gt; ===
gt; Or you could use an API function call:
gt;
gt; Option Explicit
gt; Declare Function MakePath Lib quot;imagehlp.dllquot; Alias _
gt; quot;MakeSureDirectoryPathExistsquot; (ByVal lpPath As String) As Long
gt;
gt; Sub testme02()
gt; Dim myCell As Range
gt; Dim myPath As String
gt; Dim wks As Worksheet
gt;
gt; Set wks = Worksheets(quot;Sheet1quot;)
gt;
gt; With wks
gt; For Each myCell In .Range(quot;a1:a5quot;).Cells
gt; If myCell.Value = quot;quot; Then
gt; MsgBox quot;Ummmmmmm. Fill in those cells!quot;
gt; Exit Sub
gt; End If
gt; myPath = myPath amp; quot;\quot; amp; myCell.Value
gt; MkDir myPath
gt; Next myCell
gt; End With
gt;
gt; If Right(myPath, 1) lt;gt; quot;\quot; Then
gt; myPath = myPath amp; quot;\quot;
gt; End If
gt; MakePath myPath
gt; End Sub
gt;
gt;
gt; Alarmbloke wrote:
gt; gt;
gt; gt; Hi,
gt; gt;
gt; gt; Can any one help with this dilemma,
gt; gt;
gt; gt; When clicking on a macro to save an excel file I need to create multiple
gt; gt; folders if they don't already exist, within the C directory,
gt; gt;
gt; gt; IE C:\Folder1\Folder2\Folder3\Folder4\Folder5\filenam e.xls
gt; gt;
gt; gt; Each Folder Name is allocated from a the contents of a Cell
gt; gt;
gt; gt; IE Cell A1 = Folder 1
gt; gt; Cell A2 = Folder 2 etc
gt; gt;
gt; gt; And the filename is also in a cell.
gt; gt;
gt; gt; How do I get Excel to check if the folders exist and then create them if not
gt; gt; ready to save the final file in the new location??
gt; gt;
gt; gt; Thanks
gt; gt;
gt; gt; A puzzled excel student!!
gt;
gt; --
gt;
gt; Dave Peterson
gt;

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

Alarmbloke wrote:
gt;
gt; Thanks again Dave.
gt;
gt; Once again a perfect solution.
gt;
gt; Must take a course on this Excel VBA lark, is there anything it wont do??
gt; Wash the dishes, clean the car, keep the wife happy whilst I struggle away
gt; with work???
gt;
gt; quot;Dave Petersonquot; wrote:
gt;
gt; gt; One way:
gt; gt;
gt; gt; Option Explicit
gt; gt; Sub testme01()
gt; gt; Dim wks As Worksheet
gt; gt; Dim myCell As Range
gt; gt; Dim myPath As String
gt; gt; Dim testStr As String
gt; gt;
gt; gt; Set wks = Worksheets(quot;sheet1quot;)
gt; gt;
gt; gt; myPath = quot;C:quot;
gt; gt; With wks
gt; gt; On Error Resume Next
gt; gt; For Each myCell In .Range(quot;a1:a5quot;).Cells
gt; gt; If myCell.Value = quot;quot; Then
gt; gt; MsgBox quot;Ummmmmmm. Fill in those cells!quot;
gt; gt; Exit Sub
gt; gt; End If
gt; gt; myPath = myPath amp; quot;\quot; amp; myCell.Value
gt; gt; MkDir myPath
gt; gt; Next myCell
gt; gt; On Error GoTo 0
gt; gt; End With
gt; gt;
gt; gt; testStr = quot;quot;
gt; gt; On Error Resume Next
gt; gt; testStr = Dir(myPath) amp; quot;\nulquot;
gt; gt; On Error GoTo 0
gt; gt;
gt; gt; If testStr = quot;quot; Then
gt; gt; MsgBox quot;Error finding/creating: quot; amp; myPath
gt; gt; Exit Sub
gt; gt; End If
gt; gt;
gt; gt; 'do the work
gt; gt;
gt; gt; End Sub
gt; gt;
gt; gt; ===
gt; gt; Or you could use an API function call:
gt; gt;
gt; gt; Option Explicit
gt; gt; Declare Function MakePath Lib quot;imagehlp.dllquot; Alias _
gt; gt; quot;MakeSureDirectoryPathExistsquot; (ByVal lpPath As String) As Long
gt; gt;
gt; gt; Sub testme02()
gt; gt; Dim myCell As Range
gt; gt; Dim myPath As String
gt; gt; Dim wks As Worksheet
gt; gt;
gt; gt; Set wks = Worksheets(quot;Sheet1quot;)
gt; gt;
gt; gt; With wks
gt; gt; For Each myCell In .Range(quot;a1:a5quot;).Cells
gt; gt; If myCell.Value = quot;quot; Then
gt; gt; MsgBox quot;Ummmmmmm. Fill in those cells!quot;
gt; gt; Exit Sub
gt; gt; End If
gt; gt; myPath = myPath amp; quot;\quot; amp; myCell.Value
gt; gt; MkDir myPath
gt; gt; Next myCell
gt; gt; End With
gt; gt;
gt; gt; If Right(myPath, 1) lt;gt; quot;\quot; Then
gt; gt; myPath = myPath amp; quot;\quot;
gt; gt; End If
gt; gt; MakePath myPath
gt; gt; End Sub
gt; gt;
gt; gt;
gt; gt; Alarmbloke wrote:
gt; gt; gt;
gt; gt; gt; Hi,
gt; gt; gt;
gt; gt; gt; Can any one help with this dilemma,
gt; gt; gt;
gt; gt; gt; When clicking on a macro to save an excel file I need to create multiple
gt; gt; gt; folders if they don't already exist, within the C directory,
gt; gt; gt;
gt; gt; gt; IE C:\Folder1\Folder2\Folder3\Folder4\Folder5\filenam e.xls
gt; gt; gt;
gt; gt; gt; Each Folder Name is allocated from a the contents of a Cell
gt; gt; gt;
gt; gt; gt; IE Cell A1 = Folder 1
gt; gt; gt; Cell A2 = Folder 2 etc
gt; gt; gt;
gt; gt; gt; And the filename is also in a cell.
gt; gt; gt;
gt; gt; gt; How do I get Excel to check if the folders exist and then create them if not
gt; gt; gt; ready to save the final file in the new location??
gt; gt; gt;
gt; gt; gt; Thanks
gt; gt; gt;
gt; gt; gt; A puzzled excel student!!
gt; gt;
gt; gt; --
gt; gt;
gt; gt; Dave Peterson
gt; gt;

--

Dave Peterson

arrow
arrow
    全站熱搜
    創作者介紹
    創作者 software 的頭像
    software

    software

    software 發表在 痞客邦 留言(0) 人氣()