Question

我需要几个文件夹。我有一个列表与他们的名字和代码，但不知道如何循环它通过我的列表。几天前，我问过修复在新创建的文件夹中导出文件的代码。现在我正在尝试修改该代码，但它无法正常工作：

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

我尝试删除创建新文件的部分，但它一直开始破坏。

Answer 1

您的代码不包含循环。根据工作簿中的位置包含此文件夹名称列表，以及该列表大小的静态程度（根据您的代码我假设它包含在D列的一组单元格中，但是有还有该列中的其他内容，因此您无法使用任何处理变量列表大小的标准方法），您需要一个查看该列表的循环。

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

让我们说你的清单大小可变，不包含任何空白，并且包含在从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

也许有点迟到才能回答......

如果您的文件夹名称（完整路径）位于Sheet1范围C1：C4 Main过程将逐步执行范围中的每个单元格，调用CreateFolder过程以根据路径字符串中的要求创建所有文件夹/子文件夹。

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

因此，例如，我设置了一个动态文件夹名称：
在单元格A1中输入公式=TODAY()
在单元格C1中输入公式：="C:\Test\" & TEXT($A$1+ROW(),"mm mmm yyyy\\dd (ddd)")并向下拖动到第4行这会将日期转换为文件夹名称，使用行号增加日期您将获得四个名为C:\Test\10 Oct 2015\08 (Thu)到C:\Test\10 Oct 2015\11 (Sun)

的文件夹

从活动工作表上的文件夹名称列表中，在活动工作簿的路径中创建文件夹

2 个答案: