Vba 使用Excel中的值创建文件夹

这个地方救了我无数次，所以我又来了。我正在尝试使用Visual Basic从excel电子表格创建文件夹-我已设法在网络上找到这个简单的解决方案，该解决方案在一定程度上有效-但我也希望使用相邻单元格中的值：

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

---

但老实说，我正在抓紧救命稻草，任何帮助都会很棒。

您的代码旨在为每个选定的单元格创建单独的文件夹，而且效果很好。是否希望通过将该行中所有列的值组合为文件夹名称，为每个选定行创建一个单独的文件夹

为了澄清，让我们说：
-A1=

xx1

，B1=

xx2

-A2=

yy1

，B2=

yy2

现有宏将创建4个文件夹：

xx1

，

xx2

，

yy1

，

yy2

如果您想要两个文件夹

xx1xx2

，

yy1yy2

，您可以做一些更改，如下所示：

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

---

“这个地方救了我无数次”。。。很好，但看起来你从未接受过你之前问题的任何答案：/这很有效，非常感谢。我已经设法调整它，以增加间隔，所以它的工作非常完美。非常感谢。很高兴知道这有帮助：）

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