4

あなたが元気であることを願っています。

Excel と vba を使用して一括フォルダー クリエーターを作成しようとしています。普段は Web ベースの言語に集中しているため、VBA を使用するのは初めてなので、事前に知識が不足していることをお許しください。私はすでにいくつかのコードを持っていますが、それは私が苦労している最後の仕上げをしているだけです。

現在、ユーザーは特定のセルでディレクトリを指定し、別のセルで親ファイルの名前を指定します。ボタンをクリックすると、マクロは親ファイル セルのディレクトリと名前を使用して親フォルダーを作成します。次に、マクロの実行時に回答者が選択したセルの値を使用して、サブ フォルダーを作成します。

私は現在、サブフォルダー内にサブフォルダー (単に孫と呼びます) を作成するプロジェクトの次の段階に取り組んでいます。すべてのサブフォルダが同じ孫を持つ場合、これは簡単ですが、そうではありません。私がやりたいことは、サブフォルダーの名前を定義する各セルの右側にある 3 つの値を取得し、それらを使用して孫を作成することですが、現在使用しているコードで「無効な修飾子」メッセージが表示されます（下記参照）。

BasePath = Range("folder_path")

'Check if the project folder already exists and if so raise and error and exit
If Dir(BasePath, vbDirectory) <> "" Then
MsgBox BasePath & " already exists", , "Error"
Else

'Create the project folder
MkDir BasePath

MsgBox "Parent folder creation complete"

'Loop through the 1st tier subfolders and create them
For Each c In ActiveWindow.RangeSelection.Cells
    'create new folder path
    NewFolder = BasePath & "\" & c.Value
    'create folder

    If fs.folderexists(NewFolder) Then
        'do nothing
    Else
        MkDir NewFolder
    End If

Next c

'Create GrandChildren
For Each d In ActiveWindow.RangeSelection.Cells
    'Offset the selection to the right

    For Each e In d.Offset(0, 1).Resize(1, 3).Cells

    Test = e.Value
    GrandChild = BasePath & "\" & d.Value & "\" & Test

    If fs.folderexists(GrandChild) Then
        'do nothing
    Else
        MkDir GrandChild
    End If

Next e
Next d

MsgBox "Sub-folder creation complete"

End If

End Sub

さらに情報が必要な場合は、お知らせください。

乾杯、

ジェイソン

4

2 に答える 2

4

あなたの問題はここにあると思います

Test = d.Offset(0, 1).Select

テストは文字列で、セルを選択しています。これを試してください：

Test = d.Offset(0,1).Value
于 2012-05-03T14:22:43.243 に答える
1

これは便利だと思うかもしれません。関数に渡されたパス全体のすべてのフォルダーを作成するために使用する単純なルーチンです。

例：

  1. C:\2011\テスト\
  2. C:\2012\テスト
  3. C:\2013\Test\DeepTest\
  4. C:\2014\Test\DeeperTest\DeeperStill

上記のリストに基づいて、このマクロは 11 個のディレクトリを作成しようとしますが、それらは既に存在します...問題ありません。

Option Explicit

Sub MakeDirectories()
'Author:    Jerry Beaucaire, 7/11/2010
'Summary:   Create directories and subdirectories based
'           on the text strings listed in column A
'           Parses parent directories too, no need to list separately
'           10/19/2010 - International compliant
Dim Paths   As Range
Dim Path    As Range
Dim MyArr   As Variant
Dim pNum    As Long
Dim pBuf    As String
Dim Delim   As String

Set Paths = Range("A:A").SpecialCells(xlConstants)
Delim = Application.PathSeparator
On Error Resume Next

    For Each Path In Paths
        MyArr = Split(Path, Delim)
        pBuf = MyArr(LBound(MyArr)) & Delim
        For pNum = LBound(MyArr) + 1 To UBound(MyArr)
            pBuf = pBuf & MyArr(pNum) & Delim
            MkDir pBuf
        Next pNum
        pBuf = ""
    Next Path

Set Paths = Nothing

End Sub

UDF バージョンもあり、テスト用のサンプル ファイルはここにあります。ご参考までに。

于 2012-05-03T17:03:57.677 に答える