リストを使用して新規フォルダを大量に作成する
今回はエクセルのリストを使用して、Windowsの新規フォルダを大量に作成してみようと思います。
新規フォルダの作成には、MkDirステートメントを使用します。
MkDir Path:=新しく作成するフォルダ名
MkDirステートメントは引数に指定された文字列をフォルダ名にして新規フォルダを作成します。試しに、新しく作成するフォルダ名として、下記のリスト(1~100までの数字)を使用してみたいと思います。
ユーザーが選択したセル範囲を、Rangeや配列などで取り込み、For Each ~Nextで順番に各セルの値を取り出し、MkDirステートメントの新しく作成するフォルダ名の引数にはめ込んでいきます。
あれ?もう出来たん?というくらい、あっという間に、リストをフォルダ名にして新規フォルダを作ることができます。
以下の文字はフォルダ名として使えないので注意が必要です。
\ / : * ? " < > |
Sub リストを使用して新規フォルダを作成する() Dim mb As Integer Dim Dn As String Dim myRange As Range Dim ct As Long mb = MsgBox(prompt:="選択中のセルの文字列をフォルダ名にして新規フォルダを作成します。" & vbCrLf & _ "良ければOKし、次に新規フォルダを作成する場所を選択して下さい。", Buttons:=vbOKCancel) If mb = 2 Then '「キャンセル」を選択した場合はプロシージャを終了する Exit Sub End If With Application.FileDialog(msoFileDialogFolderPicker) .Title = "フォルダを選択して下さい" If .Show = -1 Then Dn = .SelectedItems(1) Else Exit Sub End If End With For Each myRange In Selection.SpecialCells(xlCellTypeVisible) '可視セルのみに処理を行う If myRange.Address = myRange.MergeArea(1).Address Then '結合セルの場合は左上の値のみ取り出す If myRange.MergeArea(1).Value <> "" Then 'セルの値が空白以外の場合のみ処理を行う If Dir(Dn & "\" & CStr(myRange.MergeArea(1).Value), vbDirectory) = "" Then '同名フォルダが存在しない場合のみ処理を行う MkDir Path:=Dn & "\" & CStr(myRange.MergeArea(1).Value) '新規フォルダを作成する ct = ct + 1 End If End If End If Next myRange MsgBox "作成成功:" & ct & " フォルダ" End Sub
※SubからEnd Subまでをコピーし、標準モジュール等に貼り付けて使用して下さい。なお、マクロで実行した処理は「元に戻す」ことができません。実行前に一旦保存しやり直しのできる状態にしておいて下さい。標準モジュールにコードを貼り付けてマクロを使用する方法はこちら。
※プログラムの大まかな流れ
- 各変数の宣言
- メッセージボックスで「選択中のセルの値をフォルダ名にして、新規フォルダを作成します。」のメッセージを表示し、いいえを選択された場合、プログラムを終了する。
- Application.FileDialogで、フォルダ選択のダイアログを表示し、選択されたフォルダのパスを文字列として変数に格納する
- マクロ実行前に選択されていた可視セル範囲を、For Each ~Nextで順次取り込む
- セルの値が空白以外のみ次の処理を行う(For Each ~Next内の処理)
- Dir関数でセルの値と同名のフォルダを検索し、存在しない場合のみ次の処理を行う(For Each ~Next内の処理)
- MkDirステートメントで、パス+セルの値をフォルダ名として、新規フォルダを作成する(For Each ~Next内の処理)
- 処理件数をカウントする(For Each ~Next内の処理)
- For Each ~Nextの終了
- 処理件数をメッセージ表示してプログラムを終了する