好的，我一直在与人们合作编写这段代码，他们在我们提出的一些帮助下：
这在 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