Question

好的，我一直在与这些代码的人一起工作，他们在一些帮助下我们想出了这个：

这适用于Mac和PC之间。

Option Explicit

Sub CreateFolders()

Dim Sheet1 As Worksheet 'Sheet1
Dim lastrow As Long, fstcell As Long
Dim strCompany As String, strPart As String, strPath As String
Dim baseFolder As String, newFolder As String
Dim cell As Range

Set Sheet1 = Sheets("Sheet1")

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .EnableEvents = False
End With

With Sheet1

    lastrow = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row
    baseFolder = "Lists!$G$1"
     'folders will be created within this folder – Change to sheet of your like.

    If Right(baseFolder, 1) <> Application.PathSeparator Then _
     baseFolder = baseFolder & Application.PathSeparator

       For Each cell In Range("S3:S" & lastrow)    'CHANGE TO SUIT

           'Company folder - column A

           newFolder = baseFolder & cell.Value
           If Len(Dir(newFolder, vbDirectory)) = 0 Then MkDir newFolder

           'Part number subfolder - column C

           newFolder = newFolder & Application.PathSeparator & cell.Offset(0, 1).Value
           If Len(Dir(newFolder, vbDirectory)) = 0 Then MkDir newFolder

       Next

End With

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With

End Sub

Answer 1

baseFolder = "Lists!$G$1"

这会将baseFolder分配给文字值"Lists!$G$1"，而不是单元格的内容。你可能意味着

baseFolder = Woksheets("Lists").Range("$G$1").Value

（或baseFolder = [Lists!$G$1]，如果你更喜欢这种语法）。

此外，您可能会发现此功能很有用：MakeSureDirectoryPathExists。

创建不存在的文件夹和子文件夹，但如果不存在则不创建

1 个答案: