[[20221115142652]]　『Dirを２回使いたい』（まこと）　ページの最後に飛ぶ

『Dirを２回使いたい』（まこと）

Dirを２回使用したいのですが、
VBAではそれができない為かわりになるコードを教えて頂きたいです。

BOOK"A"を開いてセル"A1"から文字を読み取る
フォルダの中からその文字を一致するBOOK"1"を開く
BOOK"A"からBOOK"1"へシートの一部をコピー＆ペースト

上記の作業を繰り返し行いたいです。

以下、私が作成したコードです。
▲の行の部分の代わりになるコードが知りたいです。

Sub KAKIKAE() '書換一括処理ツール

    Dim Path As String, FName As String, bangoun As String, YOSANSYO As String

    Path = "C:\Users\●●\Desktop\書換\" 'ファイル名取得するフォルダパス、該当拡張子を入れる
    FName = Dir(Path & "*.xlsx")  '(*)を使用し、xlsx拡張子のファイルを全て

    'Loopでファイルを取得→開く→処理→上書き保存→閉じる
    Do While FName <> ""
       Workbooks.Open Path & FName 'ファイルを上から順に開ける

       bangou = Right(Range("A1").Value, 5) 'A1から下５桁を取得
       ▲YOSANSYO = Dir(Path & bangou & "*.xlsm")

       Workbooks.Open fileName:=Path & YOSANSYO 'bangouと同じファイル名のファイルを開ける

       Workbooks(FName).Activate
       Range("A1:BJ61").Copy

       Workbooks(YOSANSYO).Sheets("●●").Range("A1:BJ61").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

       ActiveWorkbook.Close

       ActiveWorkbook.Save
       ActiveWorkbook.Close

       ▲YOSANSYO = Dir（）
       FName = Dir()

    Loop

End Sub

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

 一回全部回して、覚えておけばいいです。
 覚えておくのは配列でもいいですが、Collectionを使ってみました。

 Sub Sample()
    Dim Path As String, FName As Variant, bangoun As String, YOSANSYO As String
    Dim wbCopyFrom As Workbook, wbCopyTo As Workbook
    Dim FileLIST As Collection

    Path = "C:\Users\●●\Desktop\書換\"                     'ファイル名取得するフォルダパス、該当拡張子を入れる

    FName = Dir(Path & "*.xlsx")                             '(*)を使用し、xlsx拡張子のファイルを全て
    Set FileLIST = New Collection
    Do While FName <> ""
       FileLIST.Add Path & FName, FName                      'ファイルパスを全部ため込んでおく
       FName = Dir()
    Loop

    For Each FName In FileLIST                                      'Loopでファイルを取得→開く→処理→上書き保存→閉じる
       Set wbCopyFrom = Workbooks.Open(FName, ReadOnly:=True)        'ファイルを上から順に開ける
       bangou = Right(wb1.ActiveSheet.Range("A1").Value, 5)                  'A1から下５桁を取得
       YOSANSYO = Dir(Path & bangou & "*.xlsm")
       Set wbCopyTo = Workbooks.Open(Filename:=Path & YOSANSYO)      'bangouと同じファイル名のファイルを開ける
       wbCopyFrom.ActiveSheet.Range("A1:BJ61").Copy
       wbCopyTo.Worksheets("●●").Range("A1:BJ61").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
       wbCopyFrom.Close SaveChanges:=False
       wbCopyTo.Close SaveChanges:=True
    Next
 End Sub
（´・ω・`） 2022/11/15(火) 15:05:51

 最初に、
 YOSANSYO = Dir(Path & bangou & "*.xlsm")
 について、確認したいと思います。
 ・番号に続けて任意の文字列を含んでいるファイルにアクセスしたいからですか？
   番号 & ".xlsm"を直接開くわけにはいかないのですね？
   （もしそれで済むなら話は簡単ですが、たぶんそうではないのでしょうね）
 ・また、その該当ファイルは一つと決まっているのですか？複数ある可能性は？

 この際、FileSystemObjectを学習されることを推奨します。(*)
 ファイルを色々と操作するには、Dirだけでは不十分かもしれませんね。
 この掲示板でも回答として比較的よく出てくるツールです。

 具体的には、外側のループは、FileSystemObjectを使ったらどうですか？
 ・フォルダ配下の全ファイルを取得し、
http://officetanaka.net/excel/vba/filesystemobject/folder06.htm
 ・そのファイルの拡張子を取得し、
http://officetanaka.net/excel/vba/filesystemobject/filesystemobject16.htm
   xlsxだけを処理対象とすればよいでしょう。

 (*)
http://officetanaka.net/excel/vba/filesystemobject
 の配下にある記事は、よくまとまっていると思います。  
 　
（γ） 2022/11/15(火) 15:19:57

 こんな感じです。
 Sub test()
     Const folder As String = "C:\Users\●●\Desktop\書換"
     Dim fso As Object
     Dim f As Object

     Set fso = CreateObject("Scripting.FileSystemObject")
     For Each f In fso.GetFolder(folder).Files       'そのフォルダ配下のファイルを列挙
         If fso.GetExtensionName(f.Path) = "xlsx" Then

             '' このなかで現行の処理を行う｡
             '' f.Pathがフルパス。 f.Nameがファイル名として使えます。

         End If
     Next
     Set fso = Nothing
 End Sub
 　
（γ） 2022/11/15(火) 15:34:41

＞（´・ω・`）様

ご回答ありがとうございます。
ツールまわしてみたのですが、何も処理されませんでした。。
Pathが２回使われてますが、これは大丈夫なのでしょうか？

＞（γ）様
・番号に続けて任意の文字列を含んでいるファイルにアクセスしたいからですか？

   番号 & ".xlsm"を直接開くわけにはいかないのですね？
→はい。番号に続けて全ファイル別の文字が入っていますので　*　を使用しています。

 ・また、その該当ファイルは一つと決まっているのですか？複数ある可能性は？
→複数ある可能性はないです。

FSO、少しやってみたのですが、全然分からず。。
書いていただいたコードを参考にもう一度勉強してみます。。
参考URLもありがとうございます！
時間が空いた時にじっくり拝見します！
（まこと） 2022/11/15(火) 15:48:39

 >Pathが２回使われてますが、これは大丈夫なのでしょうか？
 テスト用の私の環境のパスでした。ちょっとやばいので削除しました。
（´・ω・`） 2022/11/15(火) 15:52:23

 回答拝見しました。了解です。では、中の処理はそのまま使えますね。
 （YOSANSYO = Dir（）は不要です）

 使ったことが無い道具が使えるようになるには、少し時間と慣れが必要なのは仕方ないです。
 今後受けるであろう利益を考えれば、最初の学習コストは小さいものだと思います。
 また全項目精読する必要は無く、ああ、こんなことができるのね程度で結構。
 実際に使う時に、詳しくみればいいと思います。
 　
（γ） 2022/11/15(火) 16:00:34

＞（´・ω・`）様

そうでしたか＞＜
改めてツールを回したところ、

実行エラー　４２４　が出ました。

bangou = Right(wb1.ActiveSheet.Range("B48").Value, 5)

↑ここで止まってしまいます＞＜
（まこと） 2022/11/15(火) 16:17:53

 wb1 を wbCopyFrom にしてください
 変数名を途中で変えたので中途半端になってしまいました 
（´・ω・`） 2022/11/15(火) 16:24:38

＞（´・ω・`）様

できました！ありがとうございます！！
ただツールを回すときに一々メッセージボックスが出てきてしまうのですが、
これをスルーする方法はありますでしょうか？

↓↓
クリップボードに大きな情報があります。この情報を他のプログラムに貼り付けられるようにしますか？
・後で貼り付けるためにクリップボードに保存する場合は、「はい」をクリック
・クリップボードにある情報を削除する場合は「いいえ」をクリック

これを自動で「はい」にしてツールを回したいです。

何度も質問してすみません。。
（まこと） 2022/11/16(水) 09:06:31

 ブックを閉じる前に
 Application.CutCopyMode = False
 してください
（´・ω・`） 2022/11/16(水) 09:39:26

＞（´・ω・`）様

出来ました！！
ありがとうございます！！
本当に助かりました＞＜
（まこと） 2022/11/16(水) 09:46:55

コメント返信：

[ 一覧(最新更新順) ]

[[20221115142652]] 『Dirを２回使いたい』（まこと） ページの最後に飛ぶ

[[20221115142652]]　『Dirを２回使いたい』（まこと）　ページの最後に飛ぶ