vba - 将 Excel 工作簿保存在新创建的同名文件夹中

Question

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

我找到的代码应该在代码编写路径中创建一个文件夹，但我希望它在与现在工作簿相同的路径中创建文件夹和新工作表。我不知道如何将其放入“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)为你”

但是我仍然不知道如何只保存一张工作表，以便带有宏的文件像模板一样工作，并且可以将表单保存到新创建的文件夹中。像一个副本。这样我就可以继续使用宏在我的文件中工作..

有效的代码!感谢@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

Answer 1

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

第一个是On error resume next如果出现错误，它不会使您的所有命令都通过。
第二个是您提供的文件夹可能是旧版本的 Windows，您直接在驱动器 C 上拥有“我的文档”文件夹。现在它通常会通过“\user”等，因此您可能会遇到访问被拒绝的问题，或者它会在根 c 上打开新文件夹，这不是您的真实文件夹。

要获取当前保存目录，请使用:

 strDefpath = Application.ActiveWorkbook.Path

第三个是您尝试将启用宏的文件另存为常规 excel 文件。再次，我相信这与旧版本的 Excel 有关，在旧版本的 Excel 中，常规 Excel 和启用的宏之间的扩展没有差异。 (它们都是 xls，不，我们有 xlsx 和 xlsm)

要将文件保存为宏启用，您需要如下行:

    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