Accessでフォルダを自動生成する方法について

質問

http://www.accessclub.jp/supbeg/091.htmlを参考に、
任意のパスを入力し、フォルダを作成するプログラムを作成いたしました。

そうしました所、存在していないフォルダの中にフォルダを作ることが出来ませんでした
(例えば c:\aaa\bbb と指定した場合、aaa フォルダが存在する場合は bbb フォルダが作成されますが、
aaa フォルダが存在しない場合、bbb フォルダが作成されませんでした)。

上記のような場合、aaa フォルダが存在しなければ、自動的に aaa フォルダを作成し、
その中に bbb フォルダを作成したいと思いましたが、良い手が思いつきませんでした。
その為、何か良い手をご存知の方がいらっしゃいましたら、アドバイスをいただければと思います。

よろしくお願いします。

回答No.3

noah7150 · ベストアンサー

ごめんごめん、自分で作成したロジックなのに・・・

最後に￥をつけて呼び出し
Call MakePath("C:\aaa\", "bbb\ccc\")
が正解。

Do
'繰り返しスタート
iPos = InStr(iPos + 1, oPath, "\")
'\が何文字目にあるか調べる
'初期値はiPos=0なので１から
'bbb\だから４が返る
'２回目は４なので５文字目から調べるbbb\ccc\なので8が返る
'３回目は９文字目から調べるが無いので０が返る
If iPos = 0 Then Exit Do
'iPosがゼロなら繰り返しを終わる
On Error Resume Next
'エラーがあっても無視する
MkDir oRoot & Left(oPath, iPos - 1)
'フォルダーを作成
'１回目はoRootとoPathの先頭から３文字つまりc:\aaa\とbbbなのでc:\aaa\bbbを作成
'２回目はoRootとoPathの先頭から７文字つまりc:\aaa\とbbb\cccなのでc:\aaa\bbb\cccを作成
On Error GoTo 0
'エラーがあったらVBAの標準エラー処理を行う
Loop
'繰り返しはここまで

以上、処理解説

お礼

ありがとうございます。
一回で最終フォルダまで作成されることを確認いたしました。
またソースのご解説までしていただきありがとうございます。
教えていただいた内容をベースに、今作成しているプログラムに反映させていただこうと思います。

回答No.2

noah7150

FileSystemObjectは別にScripting Runtimeを参照設定せずとも
Set fs = CreateObject("Scripting.FileSystemObject")
と書けば出来ますよFileSystemObjectでヘルプ参照

またフォルダー作成はFileSystemObjectを使わなくてもVBA標準命令にMkDirがあります

サンプルです。

本来ならDir(Folder)で有無チェックするのが正解なのでしょうが
すでに存在する場合、エラーになるがOn Error Resume Nextで無視するように手抜きしてます
呼び出しは作成元フォルダー、追加したいフォルダーです

Call MakePath("C:\aaa\", "bbb\ccc")

Function MakePath(oRoot As String, oPath As String)
Dim iPos As Long

iPos = 0
Do
iPos = InStr(iPos + 1, oPath, "\")
If iPos = 0 Then Exit Do
On Error Resume Next
MkDir oRoot & Left(oPath, iPos - 1)
On Error GoTo 0
Loop
End Function

お礼

ありがとうございます。
意図した動作になりました。
ただソースの意味が理解できていない為、これからソースの理解に勤めたいと思います。

後、教えていただいたソースでは最終フォルダ(ccc)は作成されず、その後に、fso.CreateFolder(C:\aaa\bbb\ccc)を行うという認識で大丈夫でしょうか？
もし私の認識が間違っているようでしたら、ご指摘いただければと思います。

回答No.1

imogasi

全般にFSO（VBScript)を使うとよいと思います。
aaa フォルダが存在する場合
aaa フォルダが存在しない場合
はFolderExist(パス名）で確認します。
「FolderExist」でWEB照会（Googleなど）のこと。
ーー
存在すれば
fso.CreateFolder ("C:\Documents and Settings\XXXX\My Documents\bbb")
の前半にaaa間でのパスを指定し（ドライブレターからすべて）、最後の部分に
￥bbbを入れます(上記のように）。
ーー
存在しない場合、
aaaの親フォルダ名でfso.CreateFolderの前の部分を指定して、最後の部分で￥aaaを指定します。親フォルダは存在を操作で確認しておく。
それでaaaフォルダが出来ます。
その後は、引き続き、上記の「存在する場合」のスクリプトのコードを入れます。bbbフォルダを中に作ります。
---
参考にフォルダ作成で
WEBにあった例を少し変えて載せておきます。アクセスVBAでテスト済み。xxxxをユーザーアカウントで変えてください。
下記ではマイドキュメントにｂｂｂフォルダが出来ます。
削除の部分はコメントアウトしてます。
Sub test02()

Dim fso, fldr, s
' FileSystemObject オブジェクトのインスタンスを取得します。
Set fso = CreateObject("Scripting.FileSystemObject")
' Drive オブジェクトを取得します。
Set fldr = fso.GetFolder("c:")
' 親フォルダの名前を表示します。
MsgBox "親フォルダの名前:" & fldr
' ドライブの名前を表示します。
MsgBox "格納されているドライブ " & fldr.Drive
' ルート ファイルの名前を表示します。
If fldr.IsRootFolder = True Then
MsgBox "これはルート フォルダです。"
Else
MsgBox "これはルート フォルダではありません。"
End If
' FileSystemObject オブジェクトでフォルダを作成します。
fso.CreateFolder ("C:\Documents and Settings\XXXX\My Documents\Bogus")
MsgBox "作成したフォルダは C:\bbb です。"
' フォルダのベース名を表示します。
MsgBox "ベース名 = " & fso.GetBaseName("C:\Documents and Settings\XXXX\My Documents\bbb")
' 作成されたフォルダを削除します。
'fso.DeleteFolder ("C:\bbb")
'MsgBox "削除したフォルダは C:\////\Bbbb です。"
End Sub

お礼

ありがとうございます。
教えていただいたソースを実行すると、マイドキュメントの中にBogusフォルダが生成されました。
ただ、今回やりたい事に結びつける事が出来ませんでした。
ご説明文から推測するに、教えていただいたソースをループさせる必要があるのかなという気がしましたが。