VBAでこんなことできます_その1 フォルダ作成
イントロ
どうもinageです。
最近はRPAとかを中心に業務自動化であれこれやっております。
RPAとかGASとかIFTTTとか、手作業でやっていたことを自動化できる仕組みが色々あって、便利な世の中ですね。
たまに理解のある現場だと「VBAで良くないっすか」という意見が通ったり、運が良いと「じゃあちょっと教えてよ」と言われることもあって嬉しい限りです。
そんな時、「VBAでこんなことできます」ととりあえず見せて「おー」と言ってもらいたい。
何も準備がない時にすぐに見せられるものがあればいいな、ということで久しぶりにこのブログを思い出しました。
が
あんまり見せられるものがない。。。
で
簡単なもので、どんなことができるかわかるようなものをほぼ自分のためにいくつか上げていきたいとおもいます。
どんなマクロ
フォルダを選択して、その配下にサブフォルダを一括で作ります。
使い方
1)フォルダ選択ボタン-> フォルダを選択する
2)B7以下に作りたいサブフォルダ名を入力していく
3)フォルダ作成ボタンを押す
コード
Option Explicit Sub フォルダ選択() Dim r As Range Set r = Sheets(1).Range("B2") With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .InitialFileName = ActiveWorkbook.Path If .Show = True Then r = .SelectedItems(1) End If End With End Sub Sub フォルダ作成() Dim rootPath As String Dim i As Long Dim maxRow As Long Dim folderName As String Dim fullPath As String Const startRow = 7 rootPath = Range("B2") If Dir(rootPath, vbDirectory) = "" Then MsgBox "フォルダを選択してください" End End If maxRow = Cells(Rows.Count, 2).End(xlUp).Row If maxRow < startRow Then MsgBox "サブフォルダ名をB列に1つ以上入れてください" End End If For i = startRow To maxRow folderName = Cells(i, 2) fullPath = rootPath & "¥" & folderName ' Debug.Print i & "_" & fullPath If Dir(fullPath, vbDirectory) = "" Then MkDir fullPath End If Next End Sub
諸注意
・Windowsで動作します
・デモ用なので、エラー処理とかちゃんとやってません
・自由に使っていただいて構いませんが、自己責任でお願いします
・バナナはおやつに入りません