4

一切顺利。

我正在尝试使用 Excel 和 vba 创建一个海量文件夹创建器。这是我第一次使用 VBA，因为我通常专注于基于 Web 的语言，所以请原谅我事先缺乏知识。我已经有一些代码，它只是在完成我正在努力的最后润色。

当前，用户在给定单元格中指定目录，在另一个单元格中指定父文件的名称。单击按钮后，宏将使用父文件单元格中的目录和名称创建父文件夹。然后，它使用受访者在运行宏时选择的任何单元格的值创建子文件夹。

我目前正在努力处理项目的下一阶段，即在子文件夹中创建子文件夹（我将称之为孙子文件夹）。如果所有子文件夹都有相同的孙子，这将很容易，但事实并非如此。我想做的是获取每个单元格右侧的 3 个值，这些值定义了子文件夹的名称，并使用它们来创建孙子，但是我目前正在使用我当前使用的代码收到“无效的限定符”消息（见下文）。

BasePath = Range("folder_path")

'Check if the project folder already exists and if so raise and error and exit
If Dir(BasePath, vbDirectory) <> "" Then
MsgBox BasePath & " already exists", , "Error"
Else

'Create the project folder
MkDir BasePath

MsgBox "Parent folder creation complete"

'Loop through the 1st tier subfolders and create them
For Each c In ActiveWindow.RangeSelection.Cells
    'create new folder path
    NewFolder = BasePath & "\" & c.Value
    'create folder

    If fs.folderexists(NewFolder) Then
        'do nothing
    Else
        MkDir NewFolder
    End If

Next c

'Create GrandChildren
For Each d In ActiveWindow.RangeSelection.Cells
    'Offset the selection to the right

    For Each e In d.Offset(0, 1).Resize(1, 3).Cells

    Test = e.Value
    GrandChild = BasePath & "\" & d.Value & "\" & Test

    If fs.folderexists(GrandChild) Then
        'do nothing
    Else
        MkDir GrandChild
    End If

Next e
Next d

MsgBox "Sub-folder creation complete"

End If

End Sub

如果您需要任何进一步的信息，请告诉我。

干杯，

杰森

4

2 回答 2

4

我认为你的问题在这里

Test = d.Offset(0, 1).Select

测试是一个字符串，您正在选择一个单元格。你应该试试这个：

Test = d.Offset(0,1).Value
于 2012-05-03T14:22:43.243 回答
1

您可能会发现这很有用，这是我用来将整个路径中的所有文件夹输入函数的简单例程。

例子：

  1. C:\2011\测试\
  2. C:\2012\测试
  3. C:\2013\Test\DeepTest\
  4. C:\2014\Test\DeeperTest\DeeperStill

根据上面的列表，这个宏将尝试创建 11 个目录，这些目录已经存在......没问题。

Option Explicit

Sub MakeDirectories()
'Author:    Jerry Beaucaire, 7/11/2010
'Summary:   Create directories and subdirectories based
'           on the text strings listed in column A
'           Parses parent directories too, no need to list separately
'           10/19/2010 - International compliant
Dim Paths   As Range
Dim Path    As Range
Dim MyArr   As Variant
Dim pNum    As Long
Dim pBuf    As String
Dim Delim   As String

Set Paths = Range("A:A").SpecialCells(xlConstants)
Delim = Application.PathSeparator
On Error Resume Next

    For Each Path In Paths
        MyArr = Split(Path, Delim)
        pBuf = MyArr(LBound(MyArr)) & Delim
        For pNum = LBound(MyArr) + 1 To UBound(MyArr)
            pBuf = pBuf & MyArr(pNum) & Delim
            MkDir pBuf
        Next pNum
        pBuf = ""
    Next Path

Set Paths = Nothing

End Sub

这里也有一个 UDF 版本和一个用于测试的示例文件。供参考。

于 2012-05-03T17:03:57.677 回答