Create a subfolder

[Casey]

Hi,
I have several workbooks that use a routine to copy a worksheet and then open the Save As dialog box.
What I would love to be able to do is to have a routine that looks at the folder the original workbook is already saved in, create a subfolder in that folder, with a particular name and save the copy of the worksheet in that new subfolder. Hope I'm clear.

[Jim Thomlinson]

Untested but this should be close...

sub whatever()
on error resume next
mkdir thisworkbook.Path & "\MyDirectory"
on error goto 0

application.dialog(xlDialogSaveAs).show thisworkbook.Path & "\MyDirectory"
....



--
HTH...

Jim Thomlinson


"Casey" wrote:

>
> Hi,
> I have several workbooks that use a routine to copy a worksheet and
> then open the Save As dialog box.
> What I would love to be able to do is to have a routine that looks at
> the folder the original workbook is already saved in, create a
> subfolder in that folder, with a particular name and save the copy of
> the worksheet in that new subfolder. Hope I'm clear.
>
>
> --
> Casey
>
>
> ------------------------------------------------------------------------
> Casey's Profile: http://www.excelforum.com/member.php...fo&userid=4545
> View this thread: http://www.excelforum.com/showthread...hreadid=518887
>
>

[Casey]

Jim,
Thanks for the reply, but I'm getting the following error message.
Run-time error 438
Object doesn't support this property or method.

Here is my full Code

Private Sub cmdCopyTransmittal_Click()
Dim c As Range
Dim d As Range

Sheets("TRANS(0)").Copy
ActiveSheet.Unprotect ("geekk")
Set d = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas)
For Each c In d
With c
.Value = .Value
End With
Next c
ActiveSheet.Shapes("cmdCopyTransmittal").Delete
ActiveSheet.Shapes("cmdImportSubmittals").Delete
ActiveSheet.Shapes("cmdAddRow").Delete
ActiveSheet.Shapes("cmdDeleteRow").Delete

ActiveSheet.Protect ("geekk"), DrawingObjects:=True, Contents:=True, _
Scenarios:=True
On Error Resume Next
MkDir ThisWorkbook.Path & "\MyDirectory"
On Error GoTo 0
'DEBUG HIGHTLIGHTS THIS NEXT LINE
Application.Dialog(xlDialogSaveAs).Show ThisWorkbook.Path & "\MyDirectory"
End Sub

[Jim Thomlinson]

Sorry. Typo. Should be Dialogs and you should add an intended file name (the
intention of the ... in my original post).

Application.Dialogs(xlDialogSaveAs).Show ThisWorkbook.Path &
"\MyDirectory\MyFile.xls"
--
HTH...

Jim Thomlinson


"Casey" wrote:

>
> Jim,
> Thanks for the reply, but I'm getting the following error message.
> Run-time error 438
> Object doesn't support this property or method.
>
> Here is my full Code
>
> Private Sub cmdCopyTransmittal_Click()
> Dim c As Range
> Dim d As Range
>
> Sheets("TRANS(0)").Copy
> ActiveSheet.Unprotect ("geekk")
> Set d = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas)
> For Each c In d
> With c
> .Value = .Value
> End With
> Next c
> ActiveSheet.Shapes("cmdCopyTransmittal").Delete
> ActiveSheet.Shapes("cmdImportSubmittals").Delete
> ActiveSheet.Shapes("cmdAddRow").Delete
> ActiveSheet.Shapes("cmdDeleteRow").Delete
>
> ActiveSheet.Protect ("geekk"), DrawingObjects:=True,
> Contents:=True, _
> Scenarios:=True
> On Error Resume Next
> MkDir ThisWorkbook.Path & "\MyDirectory"
> On Error GoTo 0
> 'DEBUG HIGHTLIGHTS THIS NEXT LINE
> Application.Dialog(xlDialogSaveAs).Show ThisWorkbook.Path &
> "\MyDirectory"
> End Sub
>
>
> --
> Casey
>
>
> ------------------------------------------------------------------------
> Casey's Profile: http://www.excelforum.com/member.php...fo&userid=4545
> View this thread: http://www.excelforum.com/showthread...hreadid=518887
>
>

[Casey]

Jim,
Worked like a charm. Thank you very much.
Searching the archives I found bits of code that created directories and created file name, but I couldn't seem to boil it down to something simple for my needs.
I probably wouldn't have caught the Dialog(s) thing short of a million years but the need for a file name I should of caught. Thanks again Jim.