[[20141121192038]]　『下層複数フォルダを指定したい』（cocoa）　ページの最後に飛ぶ

『下層複数フォルダを指定したい』（cocoa）

お世話になっております。

J:\検索ファイル.xls
J:\北海道\aaa.xls
J:\東北\abb.xls
J:\関東\acd.xls
：
：
：
とファイルがあり、それぞれのエクセルを読み込んで検索ファイル.xlsに集約したく、
過去ログのhttp://www.excel.studio-kazu.jp/kw/20100220200243.htmlを参照させていただいているのですが、
検索ファイル.xlsからみて「自分の下のフォルダにあるフォルダにあるエクセル全て」としたい場合、
★ 実際のパスに修正の部分はどう指定すればいいでしょうか？

お手数おかけいたしますがご教授下さい。。。

過去ログから

 Sub gatherEXCELs()
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim dstWS As Worksheet
    Set dstWS = Workbooks.Add().Worksheets(1)
    Dim dstRow As Long
    Dim lastRow As Long
    dstRow = 1
    Dim xlFile As Object
    For Each xlFile In fso.GetFolder("D:\DataFolder").Files '★  実際のパスに修正
        If LCase(fso.GetExtensionName(xlFile.Path)) = "xls" Then
            With Workbooks.Open(xlFile.Path)
                lastRow = .Worksheets("入力シート").Range("A" & Rows.Count).End(xlUp).Row
                If lastRow >= 5 Then
                    .Worksheets("入力シート").Range("A5").Resize(lastRow - 4, 54).Copy _
                        Destination:=dstWS.Range("A" & dstRow).Resize(lastRow - 4, 54)
                    dstRow = dstWS.Range("A" & Rows.Count).End(xlUp).Row + 1
                End If
               .Close
            End With
        End If
    Next
 End Sub
 (Mook)

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

 名前が見えたので、反応しました。

 いろいろなやり方があると思いますが、とりあえずこんな感じで。

 >   Dim xlFile As Object
 >   For Each xlFile In fso.GetFolder("D:\DataFolder").Files '★  実際のパスに修正
 >       If LCase(fso.GetExtensionName(xlFile.Path)) = "xls" Then
 >           With Workbooks.Open(xlFile.Path)
               :
               :
 >           End With
 >       End If
 >   Next

↓

     Dim xlList
     xlList = CreateObject("WScript.Shell").Exec("cmd /C dir /S /B /A:-D ""D:\DataFolder""|findstr "".xls""").StdOut().ReadAll()
     Dim xlFile
     For Each xlFile In Split(xlList, vbNewLine)
         With Workbooks.Open( xlFile )
            :
            :
         End With
     Next

（Mook） 2014/11/21(金) 21:17

Mook様

すいません。一緒にコードと一緒にお名前もコピーしてしまいました。
またご回答ありがとうございました！

申し訳ありません。
ユーザごとに環境が異なり、"D:\DataFolder"に統一出来ないため、

     xlList = CreateObject("WScript.Shell").Exec("cmd /C dir /S /B /A:-D ""ThisWorkBook.Path""|findstr "".xls""").StdOut().ReadAll()

としたのですが、エラーは出ないのですが集計されませんでした。
（フォルダ以下のファイルが開いている様子がない？）
どう修正すればよいでしょうか？

（cocoa） 2014/11/21(金) 21:48

 >    xlList = CreateObject("WScript.Shell").Exec("cmd /C dir /S /B /A:-D ""ThisWorkBook.Path""|findstr "".xls""").StdOut().ReadAll()
は
      xlList = CreateObject("WScript.Shell").Exec("cmd /C dir /S /B /A:-D """ & &ThisWorkBook.Path & """|findstr "".xls""").StdOut().ReadAll()
 ですけれどこれだと自分自身も含まれてしまうので、異なるファイルのときという条件を
 入れないとエラーになりそうです。

 とりあえず、
     If Dir(xlFile) <> Thisworkbook.Name Then
     End If
 を With ～ End With の外側に書いてみてどうでしょうか。

（Mook） 2014/11/21(金) 23:48

Mookさま

ご連絡ありがとうございます。

コンパイル構文エラーとなってしまい

      xlList = CreateObject("WScript.Shell").Exec("cmd /C dir /S /B /A:-D """ & &ThisWorkBook.Path & """|findstr "".xls""").StdOut().ReadAll()
が反転してしまいます。。

 Sub gatherEXCELs()
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim dstWS As Worksheet
    Set dstWS = Worksheets(1)

    Dim dstRow As Long
    Dim lastRow As Long
    dstRow = 2

     Dim xlList
      xlList = CreateObject("WScript.Shell").Exec("cmd /C dir /S /B /A:-D """ & &ThisWorkBook.Path & """|findstr "".xls""").StdOut().ReadAll()
     Dim xlFile
     For Each xlFile In Split(xlList, vbNewLine)
       If Dir(xlFile) <> ThisWorkbook.Name Then
         With Workbooks.Open(xlFile)
                lastRow = .Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
                If lastRow >= 2 Then
                    .Worksheets("Sheet1").Range("A2").Resize(lastRow - 1, 10).Copy _
                        Destination:=dstWS.Range("A" & dstRow).Resize(lastRow - 1, 10)
                    dstRow = dstWS.Range("A" & Rows.Count).End(xlUp).Row + 1
                End If
               .Close
            End With
        End If
    Next
    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"", False)"
    MsgBox "集計が終わりました"
 End Sub

で何かミスがありますでしょうか？
（cocoa） 2014/11/25(火) 11:47

"cmd /C dir /S /B /A:-D """ & ThisWorkBook.Path & "\*.xls"""
（???） 2014/11/25(火) 11:56

 いつもフォローありがとうございます m(_ _)m
（Mook） 2014/11/25(火) 17:13

Mookさま、???さま　回答いただきありがとうございます。

すいません。
実施ファイルの二列目以降に、各下層ファイルに格納されているブックのSheet1の二列目以下を順次コピーしたいのです。
（cocoa） 2014/11/25(火) 11:47の文言に（???様） 2014/11/25(火) 11:56の部分を修正したところ、
現在使用中です。後でもう一度試してください。　というメッセージが出て集計されませんでした。

お手数おかけして申し訳ありません。
修正点をご教授いただければと思います。

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

サーバ上で実行したために、他の方が既にファイルを開いているのと競合したのではないでしょうか？
Workbooks.Open(xlFile) を、Workbooks.Open(xlFile, False, True) として、読み取り専用にするとどうなりますか？

それでも駄目ならば、直接開くのではなく、ローカルにファイルコピーして、コピーを開くという手もあります。
（???） 2014/12/05(金) 15:03

どうやら自分と同じ階層にあるファイルを開いてコピーしているようです。
その過程で自分自身も開こうとして使用中となっているようです。

何度も申し訳ありません。
\*.xlsの部分が上手く効いて居ないようなのですが、自分より下層のフォルダのエクセルを開いてコピーするような記述方法はありますでしょうか？
（cocoa） 2014/12/08(月) 14:57

 >その過程で自分自身も開こうとして使用中となっているようです。 
 本当でしょうか？

 そこは
       If Dir(xlFile) <> ThisWorkbook.Name Then
 で回避していると思ったのですが、警告が出たときの xlFile を確認したらそうだった
 ということでしょうか。
（Mook） 2014/12/08(月) 15:03

おそらく、自分自身のテンポラリファイル（~$）も、DIR結果に含まれているのでしょう。
ファイル名判定部分を、以下のように変えてみてください。

       If xlFile <> "" And Dir(xlFile) <> ThisWorkbook.Name And Dir(xlFile) <> "" Then
（???） 2014/12/08(月) 15:35

Mookさま、???さま　！！
ご連絡、ご対応ありがとうございます。
目的の動きをしました！！！

本当にありがとうございます。助かりました！！

コメント返信：

[ 一覧(最新更新順) ]

[[20141121192038]] 『下層複数フォルダを指定したい』（cocoa） ページの最後に飛ぶ

[[20141121192038]]　『下層複数フォルダを指定したい』（cocoa）　ページの最後に飛ぶ