[[20210601143738]]　『【VBA・FSO】名前が前方一致するフォルダをコピー』（HARIBO）　ページの最後に飛ぶ

『【VBA・FSO】名前が前方一致するフォルダをコピーしたい』（HARIBO）

＜やりたいこと＞
フォルダa内にあるフォルダを、フォルダ1にある同じ番号のフォルダのなかにコピーしたいです。
毎週何度も発生する仕事なので、自動化したいと考えました。

　○フォルダa　：　xxx_01_日付、xxx_04_日付、xxx_05_日付……
　↓
　○フォルダ1　：　xxx_01、xxx_02、xxx_03、xxx_04……
　（01は01へ、04は04へ、05は05へ……といった具合にコピーしたい）

フォルダの命名規則として、「xxx_00」までは前方完全一致ですので、この性質を使って下記のようなマクロを組みました。

しかし、デバッグしたところ、「FSO.CopyFolder Original & Name, aFolder.Path」にエラーが出ています。

初心者なので治し方が分からず、掲示板に記載した次第です。
大変恐れ入りますが、何卒よろしくお願いいたします。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

   Sub sample()
       Const Copy As String = "フォルダ1のパス"
       Const Original As String = "フォルダaのパス"

       Dim Name As String

       Dim FSO As Object, Sh As Object
       Set FSO = CreateObject("Scripting.FileSystemObject")

       Set Sh = CreateObject("WScript.Shell")

       'Copyのサブフォルダについて
       'Original内の「サブフォルダ名で始まるフォルダ」を｡そのサブフォルダにコピー

       For Each aFolder In FSO.GetFolder(Copy).SubFolders
       Name = Dir(aFolder) 'Copyのサブフォルダ名を取得
       FSO.CopyFolder Original & Name, aFolder.Path
       'Original内の「そのサブフォルダ名で始まるフォルダ」をそのサブフォルダにコピー

       Next

    End Sub

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

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

 エラーが出たとき、変数Nameの値を確認してください。

 たぶん空文字になってます。
　
 (1)フォルダ名称をちゃんと取得できるようにする
 (2)Originalのフォルダ名に一致させる

 ことが必要です。
（´・ω・`） 2021/06/01(火) 16:01

 >Name = Dir(aFolder)
 >Name = Dir(aFolder,vbDirectory)

 >(2)Originalのフォルダ名に一致させる
 一致じゃなかったですね、ワイルドカードでいいんですね

 >FSO.CopyFolder Original & Name, aFolder.Path
  FSO.CopyFolder Original & Name & *" , aFolder.Path

 でしょうか、たぶん。未検証です。
（´・ω・`） 2021/06/01(火) 16:11

コメント返信：

[ 一覧(最新更新順) ]

[[20210601143738]] 『【VBA・FSO】名前が前方一致するフォルダをコピー』（HARIBO） ページの最後に飛ぶ

[[20210601143738]]　『【VBA・FSO】名前が前方一致するフォルダをコピー』（HARIBO）　ページの最後に飛ぶ