从给定单元格右侧的范围中select值，并从中迭代创build一个子文件夹

一切顺利。

我正在尝试使用Excel和vba创build一个批量文件夹创build器。 这是我第一次使用VBA，因为我通常专注于基于Web的语言，所以原谅我缺乏知识。 我已经有一些代码，只是把我正在努力的收尾。

目前，用户在给定的单元格中指定一个目录，并在另一个单元格中指定父文件的名称。 单击一个button后，macros将使用父文件单元中的目录和名称创build父文件夹。 然后使用应答者在运行macros时select的任何单元格的值创build子文件夹。

我目前正在为子文件夹内创build子文件夹（我将其称为孙子孙女）的下一个阶段苦苦挣扎。 如果所有子文件夹都有相同的孙子，这将是容易的，但事实并非如此。 我想要做的是获取每个单元格右侧的3个值定义子文件夹的名称，并使用它们来创build孙子，但是我目前正在使用我正在使用的代码的“无效限定符”消息（见下文）。

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 

如果您需要任何进一步的信息，请让我知道。

干杯，

贾森

Answer 1

我认为你的问题在这里

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

testing是一个string，你正在select一个单元格。 你应该试试这个：

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

Answer 2

您可能会发现这很有用，这是一个简单的例程，我用它来将所有path中的所有文件夹input到函数中。

例：

1. C：\ 2011 \testing\
2. C：\ 2012 \testing
3. C：\ 2013 \testing\ DeepTest \
4. C：\ 2014 \testing\ DeeperTest \ DeeperStill

基于上面的列表，这个macros将尝试创build11个目录，已经存在的…没有问题。

 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版本，并在这里find用于testing的示例文件。 仅供参考。