Excel VBAメモ Windows APIを使わずに階層の深いフォルダーを作成してみる

2014/09/30VBA

野暮用で…VBAってフォルダーを一気に作れないのね…。
FileSystemObjectのCreateFolder()ってのにフルパスを入れると実行エラーになっちゃう…。

これは、たとえばc:\aaa\bbb\cccってパスのフォルダを作ろうとした場合、こんなことになるとエラーになっちゃう。

aaaって名前のフォルダがない
aaaって名前のフォルダがあっても、bbbってフォルダがない

そんな訳で、試しに作ったメソッドっぽいの(VBAでいうFunctionプロシージャ)はこんな感じ…。
※特にエラー処理を考えていないので、本気で使おうと思ったらエラー処理いるな…。

Public Function CreateFolder(strFolderPath As String)

	' パスを\区切りで分ける
	Dim varFolders As Variant   ' フォルダ名リスト
	varFolders = Split(strFolderPath, "\")

	' FileSystemObjectをインスタンス化する
	Dim objFileSystemObject As Object   ' FileSystemObjectオブジェクト
	Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")

	' フォルダを作成する
	Dim varValue As Variant     ' フォルダ名リストから取り出したフォルダ名
	Dim strValue As String      ' CreateFolder()の戻り値
	For Each varValue In varFolders
		' 上位層からのフォルダパスを作る
		strCurrentPath = strCurrentPath & varValue & "\"
		' フォルダがあるかチェックする
		On Error Resume Next
		If objFileSystemObject.FolderExists(strCurrentPath) = False Then
			' フォルダがなかったら新しく作る
			strValue = objFileSystemObject.CreateFolder(strCurrentPath)
		End If
		' エラーをチェックする
		If Err <> 0 Then
			' フォルダの作成に失敗したらFor文を終了する
			MsgBox "フォルダの作成に失敗しました"
			Exit For
		End If
	Next

	' 使い終わったら必ずNothingを設定する
	Set objFileSystemObject = Nothing

End Function

あと、メソッドを呼ぶためのメソッドっぽいの(VBAでいうSubプロシージャ)はこんな感じ。

Public Sub DoAction()

	' こんなパスのフォルダを作る
	Dim strFolderPath As String
	strFolderPath = "c:\aaa\bbb\ccc"

	' フォルダを作成する
	CreateFolder (strFolderPath)

End Sub

んで、結果はこんな感じ。
まずは、実行前はこんな感じで"aaa"ってフォルダーはいない。