解析エンジニアの自動化 blog

コツコツと自動化した方法を残す blog

【簡単一発コピペ】VBA でフォルダが無ければ作成するサブルーチンを作成する



こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。


この記事の目次



背景・目的


VBA で何かアプリケーションを作ると新しくフォルダを作って、その新しいフォルダにファイルを保存したくなる事がいっぱいあります。

しかも、何故かいつもソースコードを忘れてしまっていて、いつもいつもインターネットを徘徊して調べています。

なので、簡単にですが、記事に残しておくことにしました。



動作環境


Windows 7
Excel 2010



プログラム

サブルーチン


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 列に作成したいフォルダ名を入力します。


図1 作成フォルダ設定


そして、 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」をダブルクリックすれば実行できます。



コメント

忘れたら見に来てください。



以上