質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.53%
ファイル

ファイルとは、文字列に基づいた名前又はパスからアクセスすることができる、任意の情報のブロック又は情報を格納するためのリソースです。

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

パス

パス(path)はファイルシステムの場所(階層)を明示したものです。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

解決済

4回答

1006閲覧

自動でフォルダを作成する

ichigo15

総合スコア14

ファイル

ファイルとは、文字列に基づいた名前又はパスからアクセスすることができる、任意の情報のブロック又は情報を格納するためのリソースです。

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

パス

パス(path)はファイルシステムの場所(階層)を明示したものです。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

0クリップ

投稿2020/06/17 04:00

編集2020/07/01 03:43

前提・実現したいこと

あるフォルダの中に入っているフォルダ(下層部まで)を全て指定のフォルダ内に作成したいです
フォルダの作成場所はPC内だけでなく、サーバー上も想定しております

(例)

 テスト1  ⇒ テスト2  ⇒ テスト5  ⇒ テスト7

テスト1  ⇒ テスト2  ⇒ テスト6

テスト1  ⇒ テスト3

テスト1  ⇒ テスト4

C:\Users\〇〇〇\Documents\テスト1\テスト2
C:\Users\〇〇〇\Documents\テスト1\テスト3
C:\Users\〇〇〇\Documents\テスト1\テスト4
C:\Users\〇〇〇\Documents\テスト1\テスト2\テスト5
C:\Users\〇〇〇\Documents\テスト1\テスト2\テスト6
C:\Users\〇〇〇\Documents\テスト1\テスト2\テスト5\テスト7

イメージは、下記のとおりです。      
(1)フォルダを選ぶ
(2)(1)のパスをExcelに表示
(3)(1)のフォルダ一覧をExcelに作成
(4)フォルダを選ぶ
(5)(4)のフォルダに(3)のフォルダを作成

発生している問題・エラーメッセージ

(困っていること)

(3)です。

 http://www.fingeneersblog.com/1610/

こちらのサイトを参照させていただいたのですが何もおこりません
どうやったらフォルダの一覧を取得できるようになるのでしょうか?

 B列に1次フォルダ、C列に2次フォルダ、D列に3次フォルダ・・・・
入力箇所はB13からで、階層フォルダは次の行に入力できるようになりたいです。

 ご指導頂けますでしょうか。
宜しくお願いいたします

該当のソースコード

[フォルダパス]は取得したいフォルダのパスを入力しました。

'--- サブフォルダのパス一覧を配列に取得する ---' Public Sub GetAllSubFolderPath() '--- フォルダ一覧を取得したいフォルダのパス ---' Dim folderPath As String folderPath = "[フォルダパス]" '--- フォルダパスを取得する --- Dim folderList As Variant folderList = GetFolderPath(folderPath) End Sub '--- サブフォルダを再帰的に取得する関数 ---' Public Function GetFolderPath(folderPath As String) As String() '--- ファイルシステムオブジェクト ---' Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") '--- フォルダ数を格納する変数 ---' Dim n As Variant n = fso.GetFolder(folderPath).SubFolders.Count Dim r As Long Dim c As Long Application.ScreenUpdating = False For r = 1 To UBound(folderList) fs = Split(Mid(folderList(r), Len(folderPath)), "\") For c = 1 To UBound(fs) Cells(r, c + 1).Value = fs(c) Next Next Application.ScreenUpdating = True If (0 < n) Then '--- フォルダパスを格納する配列 ---' Dim str() As String ReDim str(1 To n) '--- フォルダパスを格納 ---' Dim i As Long Dim j As Long Dim m As Long i = 1 Dim strTmp() As String 'フォルダパスを指定してすべてのサブフォルダを取得 Dim f As Object For Each f In fso.GetFolder(folderPath).SubFolders str(i) = f.Path strTmp = GetFolderPath(str(i)) '再帰的呼び出し If (Not IsEmptyArray(strTmp)) Then m = UBound(strTmp, 1) Else m = 0 End If 'サブフォルダ内にさらにフォルダがあればその分だけ配列を拡張 n = UBound(str, 1) ReDim Preserve str(1 To n + m) For j = 1 To m str(i + j) = strTmp(j) Next j i = i + m + 1 Next f End If GetFolderPath = str End Function '--- 配列が空かどうかを判定する関数 ---' Public Function IsEmptyArray(arrayTmp As Variant) As Boolean On Error GoTo ERROR_ If (0 < UBound(arrayTmp, 1)) Then IsEmptyArray = False End If Exit Function ERROR_: IsEmptyArray = True End Function

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

DreamTheater

2020/06/17 04:11

FOLDERPATHに定義されたシートにサブフォルダー一覧を作成するところまでは出来ていて、そのシートからサブフォルダーを生成する部分が全くできていないということですか?
ttyp03

2020/06/17 04:30

どこまでできてて、あとなにができてないかがわかりません。 あとフォルダ構成の例とかもあるといいです。
ichigo15

2020/06/17 05:31

コメントありがとうございます。 説明が不足しておりご迷惑をおかけしております。 投稿している構文は別で使用しているファイルリストを作成するものです。 まだフォルダ一覧は作成できておりません。 フォルダだけのパスを取得しようと作成中です。 そこからフォルダの一覧を作成し、一覧からフォルダを生成できればと考えております。 もちろん、フォルダ名だけが取得できればいいのですがやり方が分からないので・・・ ご指導宜しくお願い致します。
ttyp03

2020/06/18 04:11

質問事項が多すぎる(大きすぎる)ので、わからないことの3~5を順番に質問していったほうがいいでしょう。 別の質問で「フォルダ一覧をExcelに作成する方法」を立ち上げ、更に実現したい処理の中でどこまでできていて何が分からないのかを質問するようにしてください。 この質問は残しておいてもいいですが、最後に解決した結果でも書いて自己解決にでもすればよいかと思います。
ichigo15

2020/06/19 03:53

コメントありがとうございます。 質問はフォルダ一覧の書き出しだけに変更しました。 他の項目はなんとか自己解決できそうです。 もし解決点をご存じでしたらご指導宜しくお願いいたします。
kaz.Suenaga

2020/07/01 05:33

どうも質問内容が把握しきれないのですが、指定したフォルダ以下のフォルダ一覧をExcelのシートに出力しつつ、別に指定したフォルダ内にそれらのフォルダを同じように作成したい、ということですか?
ichigo15

2020/07/01 23:59

コメントありがとうございます。 説明が下手でご迷惑をおかけしております。 そのとおり、フォルダ一覧の取得とフォルダの作成です。 あるブック(以下ブックA)にマクロを設定して、 ①選択したフォルダ内にあるフォルダ一覧(下層部まで)をブックAに作成する ②フォルダを作成したい場所を選択し、ブックAにあるフォルダ一覧よりフォルダを作成する ①で取得したもの全て②で作成しない場合があるので一度Excelに一覧を取得して、確認・修正後に ②を行いたいと思っております。 もしまだ分かりにくいようでしたらご連絡くださいませ。 よろしくお願いいたします。
guest

回答4

0

回答としてあまり適切ではないと思うのですが、一通り動作するコードをあげておきます。

  • フォルダ一覧作成: get_folder_list を実行
  • フォルダ作成: create_folders を実行

でできるかと思います。
一覧は ActiveSheet 、フォルダリストの最初のセルは B2 を前提にしています。

これまでのソースをベースにしていないので理解しなおすことになるかと思いますが、読んでみてわからない点等あればコメントで再質問してください。

VBA:Excel

1Option Explicit 2 3 4' 起点フォルダを記載するセル 5Private Const CELL_BASE_FOLDER As String = "B2" 6 7 8' ------------------------------------------- 9' フォルダ一覧作成 10' ------------------------------------------- 11' ---- 起動: フォルダ一覧作成 12Sub get_folder_list() 13 ' 起点とするフォルダを選択 14 Dim base_folder_path As String 15 base_folder_path = folder_pick("作成するフォルダ一覧の対象フォルダを指定してください。") 16 17 ' フォルダが指定された場合処理開始 18 If base_folder_path <> "" Then 19 20 ' サブフォルダを再帰的に一覧取得 21 Dim fso As Object 22 Set fso = CreateObject("Scripting.FileSystemObject") 23 24 Dim folder_list As Variant ' サブフォルダリスト(配列) 25 get_sub_folders fso.GetFolder(base_folder_path), folder_list 26 Set fso = Nothing 27 28 ' シートに転記 29 write_folder_list ActiveWorkbook.ActiveSheet, base_folder_path, folder_list 30 Else 31 ' フォルダ指定しなかった場合の動作 32 End If 33End Sub 34 35' ---- 再帰的にサブフォルダを検索 36' TARGET: 検索対象のフォルダオブジェクト 37' arr: フォルダリスト配列(参照渡し) 38Private Sub get_sub_folders(TARGET As Object, ByRef arr As Variant) 39 Dim sub_folder As Object 40 41 For Each sub_folder In TARGET.SubFolders 42 push_arr sub_folder.PATH, arr 43 get_sub_folders sub_folder, arr 44 Next 45End Sub 46 47' ---- シートにフォルダリストを出力 48' ws: 出力するシート 49' base_folder_path: ベースフォルダ 50' folder_list: フォルダリスト配列 51Private Sub write_folder_list(ws As Worksheet, base_folder_path As String, folder_list As Variant) 52 Dim i As Long 53 Dim j As Long 54 Dim path_array As Variant 55 56 ' 起点とするセル 57 With ws.Range(CELL_BASE_FOLDER) 58 ' ベースとしたフォルダをそのセルに記載 59 .Value = base_folder_path 60 61 ' 以下ループしながらセルに出力(offset で起点セルからの相対位置をずらしながら出力) 62 For i = LBound(folder_list) To UBound(folder_list) 63 64 ' 配列要素からベースフォルダ部分を削除し、残りを \ で分割して配列化 65 path_array = Empty 66 path_array = Split(Replace(folder_list(i), base_folder_path & "\", ""), "\") 67 68 ' 念のために配列化されているかをチェック 69 If IsArray(path_array) Then 70 ' セルに記載 71 .Offset(i - LBound(folder_list) + 1, 0).Value = base_folder_path 72 For j = LBound(path_array) To UBound(path_array) 73 .Offset(i - LBound(folder_list) + 1, j - LBound(path_array) + 1).Value = path_array(j) 74 Next 75 End If 76 Next 77 End With 78 79 Set ws = Nothing 80End Sub 81 82 83 84' ------------------------------------------- 85' フォルダ作成 86' ------------------------------------------- 87' ---- 起動: フォルダ作成 88Sub create_folders() 89 90 ' 元とするシート 91 Dim ws As Worksheet 92 Set ws = ActiveWorkbook.ActiveSheet 93 94 ' 作成先のフォルダを取得 95 Dim dest_folder_path As String 96 dest_folder_path = folder_pick("サブフォルダを作成するフォルダを指定してください。") 97 98 ' 作成先のフォルダを指定された場合 99 If dest_folder_path <> "" Then 100 Dim fso As Object 101 Set fso = CreateObject("Scripting.FileSystemObject") 102 103 ' 指定したフォルダ内が空でない場合は念のため終了 104 If Dir(fso.BuildPath(dest_folder_path, "*")) <> "" Then 105 MsgBox "指定したフォルダ内が空ではないようです。安全のため処理を中止します。", vbOKOnly, "中止" 106 Exit Sub 107 End If 108 109 ' サブフォルダ作成 110 ' ================================================= 111 ' Excelのシートからデータ取得 112 With ws.Range(CELL_BASE_FOLDER) 113 Dim target_path As String 114 Dim i As Long ' 相対行に相当 115 Dim j As Long ' 相対列に相当 116 117 ' 行の初め(フォルダ一覧を作成した際の検索基点フォルダ名が入っているはず)が空になるまで行方向にループ 118 i = 1 119 Do Until .Offset(i, 0).Value = "" 120 ' フォルダ作成する基点フォルダパスを設定 121 target_path = dest_folder_path 122 123 ' 列(=フォルダ階層)がなくなるまで列方向にループ 124 ' 列の上位からたどっているため、パスを追記しながらフォルダの存在をチェックしなければ作る、を繰り返す 125 j = 1 126 Do Until .Offset(i, j).Value = "" 127 target_path = fso.BuildPath(target_path, .Offset(i, j).Value) 128 If Not (fso.FolderExists(target_path)) Then MkDir target_path 129 j = j + 1 130 Loop 131 i = i + 1 132 Loop 133 End With 134 135 Set fso = Nothing 136 Set ws = Nothing 137 Else 138 ' フォルダ指定をキャンセルした場合の処理 139 End If 140End Sub 141 142 143 144 145' ------------------------------------------- 146' 共通関数 147' ------------------------------------------- 148 149' ---- フォルダ選択ダイアログ 150Private Function folder_pick(Optional dialog_title As String = "") As String 151 Dim tmpRet As String 152 153 With Application.FileDialog(msoFileDialogFolderPicker) 154 .AllowMultiSelect = False 155 If dialog_title <> "" Then .Title = dialog_title 156 If .Show = True Then 157 tmpRet = .SelectedItems(1) 158 Else 159 tmpRet = "" 160 MsgBox "処理を中止しました。", vbOKOnly, "中止" 161 End If 162 End With 163 164 folder_pick = tmpRet 165End Function 166 167 168' ---- 配列の最後にデータ追加 169Private Sub push_arr(DATA As Variant, ByRef arr As Variant) 170 171 If IsArray(arr) Then 172 ReDim Preserve arr(UBound(arr) + 1) 173 Else 174 ReDim arr(0) 175 End If 176 177 ' 配列に代入 178 If IsObject(DATA) Then ' データがオブジェクトの場合 179 Set arr(UBound(arr)) = DATA 180 Else ' データがオブジェクトではない場合 181 arr(UBound(arr)) = DATA 182 End If 183End Sub 184

投稿2020/07/02 03:49

編集2020/07/02 03:52
kaz.Suenaga

総合スコア2037

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

ichigo15

2020/07/03 04:01

コメントありがとうございます。 タイムラグで今朝、回答を頂けたことを通知するメールを受信いたしました すいません、入れ違いだったようです 自分ではパスを分解できず諦めておりましたが、とても勉強になりました。 感謝いたします。
guest

0

前の質問ですが、ベストアンサーがついていなかったので回答させて頂きます。
まず、貴方の行いたいVBAでのフォルダ自動作成はCreateFolder関数と言う関数を呼ばないと作成されません。
しかし、この関数も再帰的にフォルダーを作成してくれる訳ではなく、
例えば、
C:\Users\〇〇〇\Documents\テスト1\テスト2
の場合、テスト2をまず作成しようとしてテスト1がないのでエラーになります。
上位の階層にフォルダがないと作成できないと言うことです。

その為、GetParentFolderName関数を使い上位の階層にフォルダがあるかをチェックしていく必要があります。そのチェックの為にFolderExists関数を利用しながら開発を行うと良いでしょう。

これらの関数はScripting.FileSystemObjectの中にあるので、自分で調べながら行ってみましょう。

投稿2020/07/02 01:03

stdio

総合スコア3307

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

ichigo15

2020/07/02 03:59

コメントありがとうございます。 丁寧な説明でとても分かりやすかったです。 引続き勉強してみようと思います。
guest

0

もしかして、

folderPath = "[フォルダパス]"

の、"[フォルダパス]"に設定している内容が間違っていて、folderPathが空っぽになっているんじゃないかと思いました。

今回の例でいうと、

folderPath = "C:\Users\〇〇〇\Documents\テスト1"

のように、検索開始位置のパスを指定しないとfolderPath配列ができません。

もし上記に問題がないようであれば、こちらの見当違いなので無視してください。

投稿2020/06/27 05:16

kenshirou

総合スコア772

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

ichigo15

2020/07/01 03:50

コメントありがとうございます。 該当のソースコードにも書いてはいるのですが ”[フォルダパス]は取得したいフォルダのパスを入力しました。” エラーはないので書き出しができてないのではないかと思います。 もしご存じでしたら教えて頂けないでしょうか。 宜しくお願いいたします。
kenshirou

2020/07/01 07:33 編集

あれ?「該当のソースコード」は、こんなコードでしたっけ? GetFolderPath(folderPath)を使って、folderPath配下のサブフォルダのパス(「C:\Users\〇〇〇\Documents\テスト1\テスト2」や「C:\Users\〇〇〇\Documents\テスト1\テスト3」)を取得し、これを使用して「...\テスト1\テスト2」を「テスト1」と「テスト2」のように分割するのであれば理解できるのですが... 上記「テスト1」「テスト2」の分割はGetFolderPath関数の中で行うべきことではないと思います。 本来であれば、Public Sub GetAllSubFolderPath()関数の folderList = GetFolderPath(folderPath) の下に、ttyp03様のコードを書けばよいと思います。 ただし、以下の注意が必要です。 ・fs変数の定義(Dim)を忘れないこと。(厳密にはString()) ・前者のコードを使う場合、   fs = Split(Mid(folderList(r), Len(folderPath)), "\")  ではなく、   fs = Split(Mid(folderList(r), Len(folderPath) +1), "\")  のようにすること。
ichigo15

2020/07/02 03:58

コメントありがとうございます。 私が教えて頂いたコードを挿入する場所を間違えているのだと思います Dim As Stringでは「配列がありません」とエラーになりましたので 私はVariantにしました。
guest

0

ベストアンサー

こんな感じですかねぇ。
GetFolderPathの下に入れてください。

VBA

1Dim r As Long 2Dim c As Long 3Application.ScreenUpdating = False 4For r = 1 To UBound(folderList) 5 fs = Split(Mid(folderList(r), Len(folderPath)), "\") 6 For c = 1 To UBound(fs) 7 Cells(r, c + 1).Value = fs(c) 8 Next 9Next 10Application.ScreenUpdating = True

上の処理はベタに処理しているので件数が多いと結構遅いです。
以下は配列化して高速化したものです。

VBA

1Dim r As Long 2Dim c As Long 3ReDim tmp(UBound(folderList), 1) As Variant 4Application.ScreenUpdating = False 5For r = 1 To UBound(folderList) 6 fs = Split(Mid(folderList(r), Len(folderPath) + 1), "\") 7 If UBound(fs) > UBound(tmp, 2) Then 8 ReDim Preserve tmp(UBound(tmp, 1), UBound(fs)) 9 End If 10 For c = 0 To UBound(fs) 11 tmp(r - 1, c) = fs(c) 12 Next 13Next 14Range("B1").Resize(UBound(tmp, 1), UBound(tmp, 2)) = tmp 15Application.ScreenUpdating = True 16

投稿2020/06/19 04:33

ttyp03

総合スコア16996

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

ichigo15

2020/06/22 03:58

コメントありがとうございます。 少し教えて頂けないでしょうか? Dim n As Variant n = fso.GetFolder(folderPath).SubFolders.Count の後に教えて頂いた構文を追加いたしました。 fsの定義をLongにして実行したら、UBoundの配列がありませんとなってしまいました ご指導いただけないでしょうか 宜しくお願いいたします。
ttyp03

2020/06/22 04:01

fsにはパスを\マークごとに区切った文字列の配列が入ります。 なのでLongにはできません。
ttyp03

2020/06/22 07:06

「まだ回答を求めています」となっていますが、期待していた回答と違いましたか?
ichigo15

2020/07/01 03:47

コメントありがとうございます。 能力が低いのでせっかく教えて頂いたコードを挿入しましたがエラーを回避できないでいます なので希望していた通りかどうかがまだ分かっておりません 質問文を教えて頂いたコードを挿入したものに変更いたしました 挿入したコードでエラーが出ております どのように修正したらよいか教えていただけないでしょうか 宜しくお願いいたします。
ttyp03

2020/07/02 00:04

入れてるところが違いますね。 GetAllSubFolderPath関数でGetFolderPath関数を呼んでいる下の行に入れてください。 '--- フォルダパスを取得する --- Dim folderList As Variant folderList = GetFolderPath(folderPath) ここに入れる End Sub 補足 GetFolderPath関数でフォルダのリストが取得できているのは確認されているでしょう。 その関数の戻り値folderListを使ってシートに展開するという流れです。
ichigo15

2020/07/02 04:04

コメントありがとうございます。 コードを挿入する場所を間違えておりました申し訳ございません。 違う方法でも最下層のフォルダ名しか取得できずに諦めておりました。 教えて頂いたコードで希望通りにフォルダ一覧を取得できることができました、感謝いたします。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.53%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問