【VBA】フォルダを作成してその中に保存する

エクセルVBAでよく使うコードの備忘録。ワークブックを保存する際にフォルダが存在しなければ自動で作成してその中にファイルを保存するコード。複数階層のフォルダを一括で作成するコードについても一緒に記載してあります。ファイルシステムオブジェクトを利用する方法についてはこちら。

スポンサーリンク

MkDir関数

フォルダを作成するにはMkDir関数を使用します。MkDir関数の使い方は簡単で、引数として作成したいフォルダのパスを与えてやれば、そのフォルダを作成してくれます。

なお、カッコに囲まれた部分（[***]）を自分のプログラムに合わせて変更してください。

構文

Call MkDir("[作成フォルダのパス]")

ただ、MkDir関数を使用する際には気を付けなくてはいけないことが２つあります。

  • 作成するフォルダが既に存在しているとエラーになる
  • 作成先フォルダの親フォルダも存在していないとエラーになる

実際に使用する際はこれらの問題を解決していく必要があります。

Dir関数：ファイルの存在を確認する

問題の一つ目である「作成するフォルダが既に存在しているとエラーになる」を解決するには、作成しようとしているフォルダが存在するかしないかを判定する必要があります。この判定にはDir関数が便利です。

Dir関数は引数としてパスを与えてやると、存在する場合はそのパスを返し、存在しない場合は空白文字列（””）を返します。通常ではファイルの判定になっているので、第二引数としてフォルダの判定であることを示す定数を与える必要があります。

構文

[戻り値（文字列）] = Dir("[作成フォルダのパス]", vbDirectory)

Dir関数を使えば、作成しようとしているフォルダが存在しているかどうか判定できるので、存在していない時だけMkDir関数でフォルダを作成してやればよいわけです。

複数階層のフォルダを作成する

問題の二つ目を解決するには、親フォルダが存在するかどうかを順番に見ていく必要があります。そのためには、Dir関数で作成しようとしているフォルダが存在しなかった場合、その親フォルダが存在するかどうかをチェックして、なければさらにその親フォルダをチェックするといったような動作を実現する必要があります。

フォルダの階層がどれぐらい深いのか場合によって異なるので、このような動作を実現する際には「フォルダが存在しなければその親フォルダをチェックして、親フォルダが存在する場合のみ当該フォルダを作成する」という関数を再帰的に呼び出すことで可能となります。

ざっと読んでよくわからなければ後述するサンプルコードを見てみてください。

サンプルコード

まずはシンプルなものから。カッコに囲まれた部分（[***]）を自分のプログラムに合わせて変更してください。

フォルダがなければ作成する（単一階層）

Public Sub MkDirSingle()
    
    '--- 作成したいフォルダのパス ---'
    Dim strPath As String
    strPath = "[作成するフォルダのパス]"
    
    '--- フォルダが存在しない場合のみMkDirで作成 ---'
    If (Dir(strPath, vbDirectory) = "") Then
    
        Call MkDir(strPath)
    
    End If
    
End Sub

次は、複数階層のフォルダを作成するコードです。MkDirMultiという関数を再帰的に呼び出してこれを実現しています。作成したいフォルダを作成する前に親フォルダが存在するかどうかをまず確認し、なければ親フォルダの作成のためにMkDirMultiを呼び出すを繰り返すようになってます。

今回は、関数を自作して親フォルダのパスを取得するようにしてありますが、FileSystemObjectを使用する方法もあります。フォルダの作成もMkDir関数を使わずにFileSystemObjectを使って行うことも可能です。この方法の方がややコードがシンプルになります（詳細はこちら）。

フォルダがなければ作成する（複数階層）

Public Sub MkDirTest()
    
    '--- 作成したいフォルダのパス ---'
    Dim strPath As String
    strPath = "[作成するフォルダのパス]"
    
    '--- 複数階層のフォルダを作成 ---'
    Call MkDirMulti(strPath)
    
End Sub

'--- 複数階層のフォルダを作成する関数 ---'
Public Sub MkDirMulti(strPath As String)
    
    '--- 親フォルダのパスを格納する変数 ---'
    Dim parentPath As String
    parentPath = GetParentDir(strPath)
    
    '--- 親フォルダが存在しなければ再帰的に呼び出し ---'
    If (Dir(parentPath, vbDirectory) = "") Then
    
        Call MkDirMulti(parentPath)
        
    Else
    
        If (Dir(strPath, vbDirectory) = "") Then
            Call MkDir(strPath)
        End If
    
    End If
    
End Sub

'--- 親フォルダのパスを取得する関数 ---'
Public Function GetParentDir(path As String) As String
    
    '--- \の位置 ---'
    Dim i As Long
    i = InStrRev(path, "\")
    
    '--- \が含まれていればパスを返す ---'
    If (0 < i) Then
        GetParentDir = Left(path, i - 1)
    Else
        GetParentDir = ""
    End If
    
End Function
スポンサーリンク