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

Creating folders and new *.xlsx file with macro from template like xlsm file

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

你写下你的东西并按下按钮,它会在新创建的文件夹中保存一个 .xlsx 文件,其中包含一个 sheet(带有表单的 sheet)...所以你可以这样做这有数百个文件和文件夹。

所以最后它应该像这样工作:

  1. 您打开下面代码所在的 .xlsm 文件。
  2. 您必须 sheet 填写一份表格(稍后应该是 "exported")并且 一个列表,您可以在其中复制表单中的内容。
  3. 当您填写表格并按下按钮时,它会保存表格 sheet 在新文件夹中作为 .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 文件,这真的很烦人,当我重新打开它时,它想更新我需要删除的文件,但我不知道如何:/...它只应该 export/save一个特别的sheet

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

小心你的变量声明!

您在 OP 中的操作方式(原始 post):

strFilenamestrDirnamestrPathname 被声明为 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