1

I found this code and it should create a new folder and should save the file in it.
Problem here the code doesn't work...

The code I found should create a folder in the code written path but i want that it creates the folder and the new sheets in the same path as the workbook now is. i don't know how I can bin this in "thisWb.Path"

Original code i found

Sub Macro1()
Dim strFilename, strDirname, strPathname, strDefpath As String
On Error Resume Next ' If directory exist goto next line
strDirname = Range("A1").Value ' New directory name

strFilename = Range("A2").Value 'New file name
strDefpath = "C:\My Documents\" 'Default path name
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub

MkDir strDefpath & strDirname
strPathname = strDefpath & strDirname & "\" & strFilename 'create total string

ActiveWorkbook.SaveAs FileName:=strPathname, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

"The idea is That it wokrs like a templete ypu fill your stuff in the form and press the button and it saves the file(only the one sheet in .xls) in a new Folder(both same names, like 1102) for you"

But i still have no clue how i only can save one sheet so the file with the macro in works like a template and can save the forms to the freshly created folders. like a copy. so that i can continue working in my file with the macro..

Code that works! thanks to @Balinti

Sub Macro1()
Dim strFilename, strDirname, strPathname, strDefpath As String
On Error Resume Next ' If directory exist goto next line
strDirname = Range("D81").Value ' New directory name

strFilename = Range("D8").Value 'New file name
strDefpath = Application.ActiveWorkbook.Path 'Default path name
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub

MkDir strDefpath & "\" & strDirname
strPathname = strDefpath & "\" & strDirname & "\" & strFilename 'create total string

ActiveWorkbook.SaveAs Filename:=strPathname & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
Swi
  • 125
  • 1
  • 1
  • 14

2 Answers2

2

There are 3 problems with code you supplied.

First is On error resume next which do not make all of your commands go through if there is some error. The 2nd is that the folder you supplied is probably for old versions of windows where you had the "my documents" folder on drive C directly. Now it is usually going through "\user" etc. so you might have access denied problems or it opens new folder on root c which is not your real document folder.

To get the current saving directory use:

 strDefpath = Application.ActiveWorkbook.Path

And the 3rd is that you try to save a macro enabled file as a regular excel file. again, I believe this concern to older version of Excel where there where no differences in the extension between regular excel and macro enabled. (they were both xls and no we have xlsx and xlsm)

To save your file as a macro enable you need a line like :

    ActiveWorkbook.SaveAs Filename:=strDefpath & ".xlsm",
 FileFormat:=xlOpenXMLWorkbookMacroEnabled

Or all together:

Sub Macro1()
Dim strFilename, strDirname, strPathname, strDefpath As String
 On Error Resume Next ' If directory exist goto next line
strDirname = Range("D81").Value ' New directory name

strFilename = Range("D8").Value 'New file name
strDefpath = Application.ActiveWorkbook.Path 'Default path name
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub

MkDir strDefpath & "\" & strDirname
strPathname = strDefpath & "\" & strDirname & "\" & strFilename 'create total string

ActiveWorkbook.SaveAs Filename:=strPathname & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
Balinti
  • 1,524
  • 1
  • 11
  • 14
  • ok i built in you code but i don'T know whats wrong with the `On error resume next` the problem know i have it creates an folder but no new file... – Swi Sep 30 '15 at 06:51
  • Add the new code to OP and I will test it again or tell me what error it shows when you disable on error resume next. – Balinti Sep 30 '15 at 06:57
  • it shows no error.. how is it possible it only save one special sheet from the workbook where the code is in? so that it is a .xls? – Swi Sep 30 '15 at 07:04
  • First, I see you have both ranges on D8. please change it. – Balinti Sep 30 '15 at 07:05
  • So you want the folder and file to be with same name? – Balinti Sep 30 '15 at 07:08
  • yes it should be the same and it should only save one workbook in the new folder, so that you can countinue working in the other, it should be like a template.. – Swi Sep 30 '15 at 07:10
  • I will test this again. – Balinti Sep 30 '15 at 07:29
  • thanks! it's working The problem i now have is that i only need the one sheet in the freshly saved file and it should be a xls, is this possible? – Swi Sep 30 '15 at 07:48
  • It is possible. But that is for new OP. please accept my answer and open new one. – Balinti Sep 30 '15 at 08:01
  • See this -- https://stackoverflow.com/questions/15480389/excel-vba-check-if-directory-exists-error -- and this -- https://stackoverflow.com/questions/10803834/is-there-a-way-to-create-a-folder-and-sub-folders-in-excel-vba – shlgug Dec 07 '17 at 20:01
1

Here is an example of creating a new subfolder in an existing folder and saving a macro-enabled version of the Active book in it:

Sub swi()
   Dim NewPath As String
   NewPath = "C:\TestFolder\Swi"
   MkDir NewPath
   ActiveWorkbook.SaveAs Filename:=NewPath & "\" & "whatever.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub
Gary's Student
  • 95,722
  • 10
  • 59
  • 99
  • not what i was looking for exactly but also thanks to you. I think you could help me in my new question – Swi Sep 30 '15 at 08:15