フォルダ名の取得について

投稿者 : ぴか     投稿日時 : 2023/09/15(Fri) 12:13:21     OS : 未指定     EXCEL : 未指定

---

先日からご相談している内容に関して、追加の質問です。

五層目に格納されたフォルダの内、Sheets(1)のRange("F" & i)のセル内に書かれた文字列の左から10個の文字を含むフォルダがあれば、コピペする、とういう内容のロボットを作りたいです。
また、格納場所については、Sheets(1)のRange("D" & i)のセル内に書かれた文字列の左から３文字が「大阪府」であれば、指定した処理をしたうえで、指定したフォルダに格納し、「大阪市」、「その他」であれば、それぞれ別の処理を行いたいです。

★★の部分で、Destinationを使う場合、ワイルドカードが使用できないため、.Sheets(1)のRange("D" & i)の文字列によって決まる保存先フォルダを調べて、.Sheets(1)のRange("M" & i)に書き込み、そのフォルダパスにフォルダを保存したいと考えておりますが、

★の箇所で下記エラーが起きています。

実行時エラー５２：
「ファイル名または番号が不正です。」

何かお気づきの点ありましたらご教授くださいませ。

Sub 大阪府()

    Application.ScreenUpdating = False
    Dim fso As New FileSystemObject
    Dim fld1 As Folder, fld2 As Folder, fld3 As Folder, fld4 As Folder, fld5 As Folder
    
        Dim i As Long
        For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
               
        With ActiveWorkbook
        
            Set fld = fso.GetFolder("Z:¥〇〇¥〇〇〇")

            
            For Each fld2 In fld.SubFolders
                For Each fld3 In fld2.SubFolders
                    For Each fld4 In fld3.SubFolders
                        For Each fld5 In fld4.SubFolders
                            If fld5.Name Like "*" & Left(.Sheets(1).Range("F" & i), 10) & "*" Then
                            
                                Select Case Left(.Sheets(1).Range("D" & i), 3)
                                
                                    Case "大阪府"
                                        .Sheets(1).Range("D" & i) = Replace(.Sheets(1).Range("D" & i), "大阪府", "")
                                        .Sheets(1).Range("D" & i) = Replace(.Sheets(1).Range("D" & i), "大阪", "")
                                        ★.Sheets(1).Range("M" & i) = Dir("C:\Users\〇〇\Desktop\お大阪2\2.二次官庁\大阪府\*" & Left(.Sheets(1).Range("D" & i), 3) & "*\", vbDirectory)
                                        ★★fld5.Copy Destination:=.Sheets(1).Range("M" & i)

                                    Case "大阪市"
                                        fld5.Copy Destination:="C:¥Users¥〇〇¥Desktop¥お大阪2¥3.市町村¥ｵ大阪市¥*" & Mid(.Sheets(1).Range("D" & i), 4, 3) & "*"

                                    Case Else
                                        fld5.Copy Destination:="C:¥Users¥〇〇¥Desktop¥お大阪2¥3.市町村¥*" & Left(.Sheets(1).Range("D" & i), 2) & "*"


                                End Select

                            End If
                        Next
                    Next
                Next
            Next
        End With
        Next

End Sub

投稿者 : さんこう     投稿日時 : 2023/09/15(Fri) 12:47:42

---

＞.Sheets(1)のRange("D" & i)の文字列によって決まる保存先フォルダを調べて、.Sheets(1)のRange("M" & i)に書き込み、そのフォルダパスにフォルダを保存したい

セルに書き込んだなら、どこに保存しようとしているか
確認できるので、正しいか確認しましょう。

投稿者 : 通行人     投稿日時 : 2023/09/15(Fri) 12:56:44

---

＞ 実行時エラー５２：
＞ 「ファイル名または番号が不正です。」

文字通り、パス名が間違っているのでは？

Left(.Sheets(1).Range("D" & i), 3)に変な制御文字が入っているとか、「\」マークが余分とか。
もう少し、トライ＆エラーした方が良いと思います。（VBAの上達がしたいのなら）

十中八九、最後の「\」マークが邪魔していると思いますけど。

投稿者 : higeru     投稿日時 : 2023/09/15(Fri) 14:52:56

---

　実行時エラーの原因は通行人さんの指摘通り、★行の最後の方「..."*¥", vbDirectory)」の '\' ですね。
　ただこれを削除してエラーが出ないようになったとして、Range("M" & i) に書かれるのはフォルダの名前「だけ」ですから、次の Copy のコピー先にはそのままでは使えませんよ。

投稿者 : higeru     投稿日時 : 2023/09/15(Fri) 15:01:26

---

　自分のコメントに補足しつつ、次にまたひっかかりそうなことについて先に書いときます。

■[返信 3] higeruさん（2023-09-15 14:52:56）の記事
＞ 　ただこれを削除してエラーが出ないようになったとして、Range("M" & i) に書かれるのはフォルダの名前「だけ」ですから、次の Copy のコピー先にはそのままでは使えませんよ。

　そのままでは使えないというのは、つまりフォルダを「フルパス」で書かないとダメということですが、その後に '\' を付けるか付けないかで挙動が変わってきます（この辺はわたしも覚えきれないので、都度実験して再確認しますが）。以下参照。

【Office TANAKA - FileSystemObject[Copyメソッド]】
http://officetanaka.net/excel/vba/filesystemobject/folder16.htm

投稿者 : ぴか     投稿日時 : 2023/09/19(Tue) 10:57:02

---

皆さま

たくさんのアドバイスありがとうございます。
アドバイスの通り、「￥」を除くと次に移りました。

しかし、.Range("M" & i)には何も書き込まれていません。
また何かお気づきの点ありましたら教えてください。

投稿者 : ぴか     投稿日時 : 2023/09/19(Tue) 11:39:23

---

新たな発見がありましたので、自分で試してみます。
解決できなければまた教えてください。


■[返信 5] ぴかさん（2023-09-19 10:57:02）の記事
＞ 皆さま
＞
＞ たくさんのアドバイスありがとうございます。
＞ アドバイスの通り、「￥」を除くと次に移りました。
＞
＞ しかし、.Range("M" & i)には何も書き込まれていません。
＞ また何かお気づきの点ありましたら教えてください。
＞
＞
＞
＞

投稿者 : ぴか     投稿日時 : 2023/09/21(Thu) 13:16:24

---

無事に解決いたしました。
親切に教えてくださりありがとうございました。