将excel工作簿保存在具有相同名称的新创建的文件夹中 [英] Save excel Workbook in a new created folder with the Same names

问题描述

我找到了此代码，它应该创建一个新文件夹并将文件保存在其中.
问题在这里，代码不起作用...

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

我找到的代码应该在代码编写路径中创建一个文件夹，但是我希望它在与工作簿相同的路径中创建该文件夹和新工作表.我不知道如何在"thisWb.Path"中将其分类

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"

我找到的原始代码

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

的想法是，它像模板的ypu一样填充表格中的内容并按下按钮，然后将文件(.xls中只有一张)保存在新文件夹中(两个名称都相同，如1102)为你"

"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..

有效的代码！感谢@Balinti

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

推荐答案

您提供的代码存在3个问题.

There are 3 problems with code you supplied.

第一个是错误继续播放下一个，如果出现某些错误，这不会使您的所有命令都通过.第二个问题是，您提供的文件夹可能是用于Windows的旧版本的，在Windows的旧版本中您直接在驱动器C上拥有我的文档"文件夹.现在，它通常会通过"\ user"等进行处理，因此您可能会遇到访问被拒绝的问题，或者它在根目录c上打开了一个新文件夹，这不是您的真实文档文件夹.

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

第三个是您尝试将启用宏的文件另存为常规excel文件.再次，我相信对旧版Excel的关注，在旧版Excel中，常规excel和启用的宏之间的扩展名没有区别.(它们都是xls，没有xlsx和xlsm)

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

或全部在一起:

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

这篇关于将excel工作簿保存在具有相同名称的新创建的文件夹中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！