Question

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

我找到的代码应该在代码编写路径中创建一个文件夹，但我希望它创建文件夹和新工作表在与现在工作簿相同的路径中。我不知道如何将这个包装在＆＃34; thisWb.Path＆＃34;

我发现的原始代码

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

＆＃34;这个想法是，它像一个模板填充你的东西填写表格并按下按钮，它将文件（只有.xls中的一张）保存在一个新的文件夹（两个相同的名称，喜欢1102）为你＆＃34;

但我仍然不知道我怎么只能保存一张纸，所以带有宏的文件就像一个模板，可以将表单保存到新创建的文件夹中。像副本一样。这样我就可以继续使用宏来处理我的文件..

有效的代码！感谢@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”等，因此您可能有访问被拒绝的问题，或者它会在root c上打开新文件夹，这不是您真正的文档文件夹。

要使用当前保存目录：

 strDefpath = Application.ActiveWorkbook.Path

第三是您尝试将启用宏的文件另存为常规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

Answer 2

以下是在现有文件夹中创建新子文件夹并在其中保存启用宏的版本的活动图书的示例：

Sub swi()
   Dim NewPath As String
   NewPath = "C:\TestFolder\Swi"
   MkDir NewPath
   ActiveWorkbook.SaveAs Filename:=NewPath & "\" & "whatever.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

将Excel工作簿保存在具有相同名称的新创建文件夹中

2 个答案: