【问题标题】:Trying to create folders and subfolders from excel using VBA尝试使用 VBA 从 excel 创建文件夹和子文件夹
【发布时间】:2018-12-13 17:02:08
【问题描述】:

我在 excel 中有两列数据,我正试图将它们转换为文件夹和子文件夹列表。 A 列将是主文件夹的第一个列表,B 列的每个条目将是 A 列相应文件夹中的一个子文件夹。最终结果将是 20 个文件夹,每个文件夹里面都有一个文件夹。我以前用过这个代码-

Sub MakeFolders()
Dim Rng As Range
Dim maxRows, maxCols, r, c As Integer
Set Rng = Selection
maxRows = Rng.Rows.Count
maxCols = Rng.Columns.Count
For c = 1 To maxCols
r = 1
Do While r <= maxRows
If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, c), vbDirectory)) = 0 Then
MkDir (ActiveWorkbook.Path & "\" & Rng(r, c))
On Error Resume Next
End If
r = r + 1
Loop
Next c
End Sub

-从单列数据创建单个文件夹的列表。我想知道如何更改该代码以创建包含第一列的文件夹列表,并使第二列中的每个条目成为 A 列相应文件夹中的子文件夹。Excel 电子表格如下所示:

    Column A        Column B
1   Folder 1    Subfolder in Folder 1
2   Folder 2    Subfolder in Folder 2
3   Folder 3    Subfolder in Folder 3
4   Folder 4    Subfolder in Folder 4
5   Folder 5    Subfolder in Folder 5
6   Folder 6    Subfolder in Folder 6
7   Folder 7    Subfolder in Folder 7
8   Folder 8    Subfolder in Folder 8
9   Folder 9    Subfolder in Folder 9
10  Folder 10   Subfolder in Folder 10

由于我对 VBA 的了解非常有限,任何帮助都将不胜感激!

【问题讨论】:

  • 我相信有人会建议你使用递归来实现这一点
  • 摆脱 On Error Resume Next 它可能会向你隐瞒问题
  • @chris 我错过了。 On Error Resume Next。仅用于下一行,后跟 On Error Goto 0。在 Next 之前确实放错了位置。为什么是梅森?
  • @peakpeak 好吧,我真的没有描述为什么会出现在代码中,但我遇到的问题不在于代码中的错误。以前使用时,我发布的代码可以正常工作,并且可以毫无问题地创建一个文件夹列表。我的问题是如何改变它来实现我改变的目标。
  • 缩进不是为了“工作”(除非你在 Python 中)——它是为了阅读。我所建议的只是考虑通过缩进任何已发布的代码来让我们所有人的生活更轻松。

标签: excel vba


【解决方案1】:

未经测试:

Sub MakeFolders()
    Dim Rng As Range, rw As Range, c As Range
    Dim p As String, v As String

    Set Rng = Selection

    'process each selected row
    For Each rw In Rng.Rows
        p = ActiveWorkbook.Path & "\" 'set initial root path for this row
        'process each cell in this row
        For Each c In rw.Cells
            v = Trim(c.Value) 'what's in the cell?
            If Len(v) > 0 Then
                If Len(Dir(p & v, vbDirectory)) = 0 Then MkDir (p & v) 'create if not already there
                p = p & v & "\" 'append to path (regardless of whether it needed to be created)
            End If
        Next c
    Next rw

End Sub

【讨论】:

  • 哇,谢谢!我对其进行了测试,看起来它运行良好。尽管我对 VBA 缺乏了解,但我感谢您坐下来为我的问题写出解决方案。
  • Mason B. - 还要注意 Tim 如何缩进他的代码。它使它更具可读性。
猜你喜欢
  • 2020-07-18
  • 2012-06-03
  • 1970-01-01
  • 2021-05-27
  • 2015-06-07
  • 2016-02-20
  • 1970-01-01
  • 2018-12-20
  • 1970-01-01
相关资源
最近更新 更多