在活动工作表的文件夹名称列表中创build活动工作簿path中的文件夹

我需要几个文件夹。 我有一个名单与他们的名字，并有代码，但不知道如何循环通过我的名单。 前几天我问过修复在新创build的文件夹中输出文件的代码。 现在我试图修改该代码，但它不起作用：

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 

我试图删除它创build一个新文件的部分，但它开始打破所有的时间。

Answer 1

您的代码不包含循环。 根据工作簿中的哪个位置包含文件夹名称列表，以及该列表的大小是多less（基于您的代码，我假设它包含在D列中的一组单元格中，但也有其他在这个列中的东西，所以你将无法使用任何标准的方法来处理一个variables列表大小），你需要一个循环，看看通过该列表。

另外，您打算在包含此代码的工作簿的path中创build所有这些文件夹，否则您需要将您的path名称设置为其他内容…

假设您的列表大小可变，不包含任何空格，并且包含在从A50开始的未知数量的单元格中，但不会超过A100。 那么你的循环可能看起来像这样：

  Dim strDirname As String, _ strPathname As String, _ strDefpath As String, _ WbMaster As Workbook For i = 1 to WorksheetFunction.Counta(Range("A50:A100")) strDirname = Range("A" & i).Value ' New directory name Set WbMaster = Application.ActiveWorkbook strDefpath = WbMaster.Path 'Default path name If Dir(strDefpath & "\" & strDirname) = "" Then MkDir strDefpath & "\" & strDirname End If Next i 

Answer 2

也许有点晚，跳回来的答案….

如果您的文件夹名称（完整path）位于Sheet1范围C1：C4。
Main过程将遍历范围中的每个单元格，调用CreateFolder过程以根据pathstring中的要求创build所有文件夹/子文件夹。

 Sub Main() Dim rCell As Range For Each rCell In ThisWorkbook.Worksheets("Sheet1").Range("C1:C4") CreateFolder rCell.Value Next rCell End Sub Sub CreateFolder(Folder) On Error Resume Next Dim objFSO As Object: Set objFSO = CreateObject("Scripting.FileSystemObject") If Folder <> "" Then If Not objFSO.FileExists(objFSO.GetParentFolderName(Folder)) Then Call CreateFolder(objFSO.GetParentFolderName(Folder)) End If objFSO.CreateFolder (Folder) End If End Sub 

所以，例如，我build立了一个dynamic文件夹名称：
在单元格A1中input公式=TODAY()
在单元格C1中input公式： ="C:\Test\" & TEXT($A$1+ROW(),"mm mmm yyyy\\dd (ddd)")并向下拖动到第4行。
这会将date转换为文件夹名称，使用行号来递增date。
你将会得到四个名为C:\Test\10 Oct 2015\08 (Thu)文件夹到C:\Test\10 Oct 2015\11 (Sun)