【簡単一発コピペ】VBA でフォルダが無ければ作成するサブルーチンを作成する
こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。
この記事の目次
背景・目的
VBA で何かアプリケーションを作ると新しくフォルダを作って、その新しいフォルダにファイルを保存したくなる事がいっぱいあります。
しかも、何故かいつもソースコードを忘れてしまっていて、いつもいつもインターネットを徘徊して調べています。
なので、簡単にですが、記事に残しておくことにしました。
プログラム
サブルーチン
Sub フォルダ作成(ByVal SaveDir)
' Path に使えない文字の配列作成
使用不可 = Array(¥, /, ", <, >, ?, [, ], :, |, *)
' Path に使えない文字の代替文字
代替文字 = "-"
' Path に使えない文字の置換
For i = LBound(使用不可) To UBound(使用不可)
If InStr(SaveDir, 使用不可(i)) > 0 Then
SaveDir = Replace(SaveDir, 使用不可(i), 代替文字)
End If
Next i
' SaveDir フォルダがなければ作成する
' SaveDir の中身は ex) みたいな感じです
' ex) SaveDir = "C:\Data\Sample"
' 最後に「 \ 」は付けない
If Dir(SaveDir, vbDirectory) = "" Then
MkDir SaveDir
End If
End Sub
使い方
今回は VBA が書かれている Excel ファイルと同じフォルダの中に大量にフォルダを作る VBA を例に使い方を整理しておきます。
図1 の様にExcel ファイルの A 列に作成したいフォルダ名を入力します。
そして、 VBE に標準モジュールを追加して、下記の Excel VBA を貼り付けます。
ちなみに、 VBE は [Alt] + [F11] を押すと起動ます。
また、標準モジュールは VBE がアクティブな時に [Alt] → [I] → [M] の順で押すと追加できます。
Excel VBA
Sub Sample()
While Cells(i, "A").Value <> ""
sDir = Thisworkbook.Path & "¥" & Cells(i, "A").Value
Call フォルダ作成(sDir)
Wend
End Sub
Sub フォルダ作成(ByVal SaveDir)
使用不可 = Array(¥, /, ", <, >, ?, [, ], :, |, *)
代替文字 = "-"
For i = LBound(使用不可) To UBound(使用不可)
If InStr(SaveDir, 使用不可(i)) > 0 Then
SaveDir = Replace(SaveDir, 使用不可(i), 代替文字)
End If
Next i
If Dir(SaveDir, vbDirectory) = "" Then
MkDir SaveDir
End If
End Sub
これで、準備は出来ました。
あとは、「Sample」マクロを実行すれば、この Excel ファイルがあるフォルダと同じ場所に Excel ファイルの A 列に書かれたフォルダが量産されます。
マクロの実行は [Alt] + [F8] を押すと選択画面が開きます。
そこで、「Sample」をダブルクリックすれば実行できます。
コメント
忘れたら見に来てください。
以上