0

わかりました、私はこのコードで人々と協力してきました、そして彼らは私たちがこれを思いついたいくつかの助けを借りて持っています：

これは、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
4

1 に答える 1

1 
baseFolder = "Lists!$G$1"

これは、セルの内容ではなく、baseFolderリテラル値に割り当てます。"Lists!$G$1"あなたはおそらく意味した

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

（またはbaseFolder = [Lists!$G$1]、その構文を好む場合）。

また、次の関数が役立つ場合もありますMakeSureDirectoryPathExists。

于 2012-06-04T13:59:44.960 に答える