VBAの勉強を始めてみた

色々試しています。

リストを使用して新規フォルダを大量に作成する

今回はエクセルのリストを使用して、Windowsの新規フォルダを大量に作成してみようと思います。
新規フォルダの作成には、MkDirステートメントを使用します。

MkDir Path:=新しく作成するフォルダ名

 

MkDirステートメントは引数に指定された文字列をフォルダ名にして新規フォルダを作成します。試しに、新しく作成するフォルダ名として、下記のリスト(1~100までの数字)を使用してみたいと思います。

f:id:kouten0430:20180513133412j:plain

f:id:kouten0430:20180513134512j:plain

ユーザーが選択したセル範囲を、Rangeや配列などで取り込み、For Each ~Nextで順番に各セルの値を取り出し、MkDirステートメント新しく作成するフォルダ名の引数にはめ込んでいきます。

 

f:id:kouten0430:20180513134636j:plain

あれ?もう出来たん?というくらい、あっという間に、リストをフォルダ名にして新規フォルダを作ることができます。

 

以下の文字はフォルダ名として使えないので注意が必要です。
\ / : * ? " < > |

 

Sub リストを使用して新規フォルダを作成する()
    Dim mb As Integer
    Dim Dn As String
    Dim myRange As Range
    Dim ct As Long
    
    mb = MsgBox(prompt:="選択中のセルの値をフォルダ名にして、新規フォルダを作成します。", Buttons:=vbYesNo)
        If mb = 7 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の終了
  • 処理件数をメッセージ表示してプログラムを終了する