[[20190220125121]]　『フォルダの作成』（ろーぐ）　ページの最後に飛ぶ

『フォルダの作成』（ろーぐ）

お邪魔します。

フォルダをたくさん作成する際に下記のマクロを使ってます。
都度A2にパスを入力しなくてもいいようにはできないものでしょうか？

よろしくお願いいたします。

Sub フォルダ作成()

    Dim Path As String '作成予定フォルダの上位パス
    Path = Range("A2").Value

    Dim i As Long 'フォルダ数カウンタ

    For i = 2 To Range("B2").End(xlDown).Row

        Dim FolderName As String '作成するフォルダ名
        FolderName = Cells(i, 2).Value

        Dim NewDirPath As String '作成予定のフォルダパス
        NewDirPath = Path & "\" & FolderName

        '作成予定フォルダと同名のフォルダの存在有無を確認し、存在しない場合フォルダ作成
        If Dir(NewDirPath, vbDirectory) = "" Then
            MkDir Path & "\" & FolderName
        Else
            MsgBox "フォルダ名：[" & FolderName & "]はすでに存在するためスキップします"
        End If

    Next i

        MsgBox "終了しました。"

End Sub

＜使用 Excel：Excel2010、使用 OS：Windows10 ＞

都度、といっても、実行する前1回だけですよね？現状でも全然問題ないと思うのですが。（親フォルダも複数あるなら、B列のように複数行に書いておいて、ループさせれば良いだけだろうし…）

それとも、ダイアログ表示してフォルダ指定したい、とか？

    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            Path = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
（???） 2019/02/20(水) 13:15

入力が手間なのであればエクセルファイルの置いてある場所を関数取得で動かしてはどうか

A2 =LEFT(CELL("filename"),FIND(">",SUBSTITUTE(CELL("filename"),"\",">",LEN(CELL("filename"))-LEN(SUBSTITUTE(CELL("filename"),"\",""))),1)-1)

これでフォルダを作りたい場所にエクセルファイルを放り込んでやれば動く
（名無） 2019/02/20(水) 13:26

＞実行する前1回だけですよね？

そのとおりです。
日に何度か実行するのですが場所が場所が変わるのでその都度入力してます。
マクロとパスが分からないという声があったので、何か方法があればと相談
いたしました。

＞ダイアログ表示してフォルダ指定したい、とか？

ダイアログ表示？
ごめんなさい、勉強不足で理解できておりません。
パスを表示させたいといことでしょうか？
それでしたら、そのとおりです。
説明が下手ですいません。

＞置いてある場所を関数取得で動かしてはどうか

取得できました。
ですがですがフォルダが作れません。
ずっ---と砂時計が出ます。
マクロに問題があるのでしょうか？

（ろーぐ） 2019/02/20(水) 17:07

補足です。

エラーメッセージは既にフォルダはありますと表示されますが
フォルダ作成されていないです。
それでずっ---と砂時計で終わる気配なしです。

明日また調べてみます。

（ろーぐ） 2019/02/20(水) 17:11

私の書いたコードは、「Path = Range("A2").Value」の1行の代わりに張り付けてからマクロ実行すれば動きますよ？それがフォルダ選択ダイアログです。事前勉強なんてしなくても良いので、動かせば判ります。

そして、B2からEnd(xlDown)しているので、B3以降のセルに何も入力していないために、1048576行まで繰り返していたりしませんか？ブレークポイントを設定するとか、途中で止めて、F8キーでステップ実行して、思った通りになっているか確認してください。（現状だと、B3セルへの入力が必須な書き方になってます）
（???） 2019/02/20(水) 17:33

 ごめんなさ、途中で我慢できなくなりました。
 口出させてください。
 変更点
 １）変数宣言をループの外に置いた
 ２）pathの指定を???さんの方法をそのまま使って、実行後に選択するようにした。
 ３）最終行の取得を、B2からCtrl＋↓から、B最終行からCtrl＋↑に変更した。
 ４）被ったフォルダがループ内でメッセージ表示されるのはうざいと思うので、
 　　最後に出力するよう変更した。
    Sub フォルダ作成()
        Dim Path As String '作成予定フォルダの上位パス
        Dim i As Long 'フォルダ数カウンタ
        Dim FolderName As String '作成するフォルダ名'   　（１
        Dim NewDirPath As String '作成予定のフォルダパス' （１
        Dim msg As String
        With Application.FileDialog(msoFileDialogFolderPicker)'（２
            If .Show = True Then
                Path = .SelectedItems(1)
            Else
                Exit Sub
            End If
        End With
        For i = 2 To Range("B" & Rows.Count).End(xlUp).Row'（３
            FolderName = Cells(i, 2).Value
            NewDirPath = Path & "\" & FolderName
            '作成予定フォルダと同名のフォルダの存在有無を確認し、存在しない場合フォルダ作成
            If Dir(NewDirPath, vbDirectory) = "" Then
                MkDir Path & "\" & FolderName
            Else
                msg = msg & vbNewLine & "[" & FolderName & "]"'（４
            End If
        Next i
        If msg <> "" Then'（４
            MsgBox "フォルダ名：" & msg & vbNewLine & "はすでに存在するためスキップしました"
        Else
            MsgBox "終了しました。"
        End If
    End Sub

（稲葉） 2019/02/20(水) 18:38

しっかりとみてないので適当ですが、
既にフォルダがある場合、メッセージを出すのは必須でしょうか？

ない場合は作って、ある場合はそのままでよければもっと単純にできそうな…

（もこな２） 2019/02/20(水) 18:56

単純に

 ルート（親）フォルダがダイアログで指定できて
 B2以下に列挙されているものが重複していようが、既に存在しようがお構いなし
 おわったことだけメッセージ表示（既にあるなどのメッセージはなし）

というルールでよければ

    Sub さんぷる()
        Dim るーと As String
        Dim i As Long

        With Application.FileDialog(msoFileDialogFolderPicker)
            If .Show = True Then
                るーと = .SelectedItems(1)
            Else
                Exit Sub
            End If
        End With

        With ActiveSheet
            For i = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
                Shell Environ$("ComSpec") & " /c md """ & るーと & "\" & .Cells(i, "B").Value & """"
            Next i
        End With

        MsgBox "おわりました"

    End Sub

↑のように、コマンドプロンプトのMDコマンドを実行すれば事足りそうな気がします。
（今回は返り値を使うわけでも、フォルダになにかを保存するわけでもないので、非同期のShell関数でもよいと考えました）

（もこな２） 2019/02/20(水) 22:56

お邪魔します。

皆さまよりご意見をいただきまして感謝いたします。
返事が遅くなりごめんなさい。

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

？？？様

ありがとうございます。
教えていただいたコードはパスを取得するものだったのですね。
勉強になります。
こちらのコードを用い、下から最終行を取得に修正いたしました。

' •フォルダを選択する[参照]ダイアログボックス
With Application.FileDialog(msoFileDialogFolderPicker)

        '有効なボタンがクリックされた
        If .Show = True Then
            'フルパスの取得
            Path = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

稲葉様

たくさんの変更ありがとうございます。

2）は、実行後とは目からウロコです。
他のコードでもそのいう考えは使えそうです。

4）は、たくさんかぶると本当にうざかったです(笑)
おかげで目がちかちかしなくなりました。

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

もこな2様

コマンドプロンプト？？
ファイル名を転記させるのにtree使った程度の知識しかありません。
もう少し勉強しておきます。
最後の「おわりました」がカワイイです。
メッセージでなくても問題ない人から好評でした。

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

皆さまに教えていただいたこと勉強して、次に生かしていきます。
本当に色々勉強になりました。

次はフォルダ名の取得を考えております。
また、分からない際はお邪魔するかもしれません。
その時はよろしくお願いします。

どうもありがとうございました。

（ろーぐ） 2019/02/21(木) 11:35

コメント返信：

[ 一覧(最新更新順) ]

[[20190220125121]] 『フォルダの作成』（ろーぐ） ページの最後に飛ぶ

[[20190220125121]]　『フォルダの作成』（ろーぐ）　ページの最後に飛ぶ