使用 xlsm 文件等模板中的宏创建文件夹和新的 *.xlsx 文件

Question

我有这段代码创建一个文件夹并将实际文件保存在其中，但我希望它只保存一个副本，其中只有一张纸。这样带有代码的文件就可以像模板一样工作...

你写下你的东西并按下按钮，它会在新创建的文件夹中保存一个带有一张表（带有表单的表）的 .xlsx 文件......这样你就可以在一个文件夹中处理数百个文件。

所以最终它应该像这样工作：

1. 您打开下面代码所在的 .xlsm 文件。
2. 您必须填写一份表格（稍后应该“导出”的内容）和 一个列表，您可以在其中复制表单中的内容。
3. 当您填写表格并按下按钮时，它会保存表格 新文件夹中的工作表为 .xlsx，您可以在 .xlsm 中继续 文件。

如果你不清楚，请询问。

我现在的代码

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

这里的问题是我有像 1102,1103 这样的表单的名称。下一步是有名称为 1102_1 和 1102_2 的文件，它们都应该放在文件夹 1102 ...

这有点超出我的知识范围，请帮助我 :) 问候

现在我正在使用下面的代码 问题是它总是关闭xlsm 文件，这真的很烦人，当我重新打开它时，它想更新我需要删除的文件，但我不知道如何：/...而且它只应该导出/保存一个专页

Private Sub CommandButton1_Click()
Dim strFilename As String, _
strDirname As String, _
strPathname As String, _
strDefpath As String, _
SheetToExport As String, _
WbMaster As Workbook, _
WbCopy As Workbook


On Error Resume Next ' If directory exist goto next line
strDirname = Range("W12").Value ' New directory name
strFilename = Range("D8").Value 'New file name

Set WbMaster = Application.ActiveWorkbook
SheetToExport = Range("A1").Value 'Or specify UserForm output

strDefpath = WbMaster.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

WbMaster.Sheets(SheetToExport).Copy
Set WbCopy = Application.ActiveWorkbook

WbCopy.SaveAs Filename:=strPathname & ".xlsx", _
                FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False

WbCopy.Close
End Sub

Answer 1

小心你的变量声明！

您在 OP 中的做法（原始帖子）：

strFilename、strDirname 和 strPathname 被声明为 Variant 而不是 String。

您仍然可以使用它们，但是如果您将它们用作参数，它会占用更多内存并且可能会出现问题。

---

查看代码：

Dim strFilename As String, _
    strDirname As String, _
    strPathname As String, _
    strDefpath As String, _
    SheetToExport As String, _
    WbMaster As Workbook, _
    WbCopy As Workbook


On Error Resume Next ' If directory exist goto next line
strDirname = Range("D81").Value ' New directory name
strFilename = Range("D8").Value 'New file name

Set WbMaster = Application.ActiveWorkbook
SheetToExport = Range("A1").Value 'Or specify UserForm output

strDefpath = WbMaster.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

WbMaster.Sheets(SheetToExport).Copy
Set WbCopy = Application.ActiveWorkbook

WbCopy.SaveAs Filename:=strPathname & ".xlsx", _
                FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False

ClosingWb = MsgBox("Do you wish to close the exported file?",vbYesNo,"Close exported file")
If ClosingWb <> vbNo Then WbCopy.Close