[[20150601143910]]　『フォルダからエクセルファイルデーターのコピー』（さんま）　ページの最後に飛ぶ

『フォルダからエクセルファイルデーターのコピー』（さんま）

フォルダの中に400のフォルダがありその一つ一つにエクセルファイルが入っています。
そのエクセルファイルの名前をＡ列、
Ｂ４の値をＢ列にコピーして一つのシートに集計したいです。

フォルダの中にはエクセル以外にJPEGファイルやWORD、PDFも入っている状況です。

現在はフォルダからエクセルファイルだけを抜き出してひとつずつ開いて値をコピーしています。。。

なにか良い方法がありましたらおしえてください。

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

 VBAでできますが
 その「ルール」が決められないと難しいと思います。

 １）何階層まで調べるか
 ２）値を取得したいブック名およびシート名は固定か　固定でない場合どのように調べるか

 最低限この二つが分かれば、叩き台だけでも作れそうです。
（稲葉） 2015/06/01(月) 15:11

シート名に規則性は？　とりあえず先頭だけ抜く例。

 Sub test()
    Const cPATH = "c:\test\"
    Dim cFiles As Variant
    Dim i As Long

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.ShowWindowsInTaskbar = False

    cFiles = Split(CreateObject("WScript.Shell").Exec("CMD /C DIR /A:-D/B/S """ & cPATH & "*.xls*""").StdOut().ReadAll(), vbNewLine)
    For i = 0 To UBound(cFiles) - 1
        With Workbooks.Open(cFiles(i), False, True)
            Cells(i + 1, "A").Value = .Name
            Cells(i + 1, "B").Value = .Sheets(1).Range("B4")
            .Close
        End With
    Next i

    Application.ShowWindowsInTaskbar = True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 End Sub
（16:28 無駄な変数を削除）

（???） 2015/06/01(月) 15:21

稲葉様、コメントありがとうございます。

１）第３階層の中にエクセルがありますので、第３階層まで
２）ブック名は全て違いますが、シートは全て　"原"というシートで固定です。

宜しくお願い致します。
　　
（さんま） 2015/06/01(月) 15:22

???様コメントありがとうございます。

ＶＢＡ試してみます。

（さんま） 2015/06/01(月) 15:22

 一例です。

 【Ｂ４の値を】とありますが、以下では、各ブックの"Sheet1"という名前のシートのB4 としています。

 Sub Test()
    Dim fPath As String
    Dim myRow As Long

    fPath = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\Test"
    myRow = 1
    Sheets("Sheet1").UsedRange.ClearContents
    ListUp fPath, myRow

 End Sub

 Sub ListUp(fPath As String, i As Long)

    Dim fso As Object
    Dim folder As Object
    Dim subfolder As Object
    Dim file As Object

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(fPath)

    'フォルダ内のサブフォルダを抽出
    For Each subfolder In folder.SubFolders
     '再帰的呼び出し
        ListUp subfolder.Path, i
    Next

    'カレントフォルダ内ファイルを抽出
    For Each file In folder.Files
        If LCase(fso.getextensionname(file.Name)) Like "xls*" Then
            Cells(i, "A").Value = file.Name
            Cells(i, "B").Value = ExecuteExcel4Macro("'" & file.parentfolder.Path & "\" & "[" & file.Name & "]Sheet1'!R4C2")
            i = i + 1
        End If
    Next file

 End Sub

（β） 2015/06/01(月) 15:32

 出る幕がない／^o^＼
（稲葉） 2015/06/01(月) 15:38

稲葉さん、コメントありがとうございます。
出てきてくれてありがとうございます。

ただ今ＶＢＡ試しています。

（さんま） 2015/06/01(月) 15:41

 βのコード、最初のフォルダをデスクトップ上の "Test" というフォルダにしています。
 ここは実際のフォルダになおしてください。

（β） 2015/06/01(月) 15:48

皆様コメントありがとうございます。
？？？さんのVBAを試したところ、VBAのブックではなくてフォルダに入っている各エクセルシートの
Ａ1とB1にファイル名と値が書き込まれてしまいます。

どのように編集すれば良いのでしょうか？

βさんのVBAを試したところ、

 Set folder = fso.GetFolder(fPath)
↑でエラーになってしまうのです。folder=Nothingなんです。
fPathは値が入っています。
（さんま） 2015/06/01(月) 17:08

 （β） 2015/06/01(月) 15:48　コメントの通り、最初のフォルダをデスクトップ上の "Test" というフォルダにしています

 同じ環境をつくって試してもらうか、この最初のフォルダ規定の

 fPath = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\Test"

 ここを実際のそちらのフォルダパスに直して試してください。

（β） 2015/06/01(月) 17:14

β様！！
私のフォルダ指定が間違っていました！！！
調べたいフォルダ階層が違っていました。
今試した所、可動しました。
いろいろ試したいと思います。

（さんま） 2015/06/01(月) 17:16

私のほうのマクロは、結果表示するシートのシートモジュールとして貼り付けて、実行してみてください。
それでもうまくいかない場合、代入先の Cells を、Me.Cells に変えてみてください。
（???） 2015/06/01(月) 17:19

β様、???様コメントありがとうございます。

β様、フォルダ階層を編集したところ、思ったように動きました！！

???様、シートモジュールとして可動したところ、思ったように動きました！！！

この問題を解くために多種な答えがあるのですね！！！

恐れ入りました。

おかげ様で作業効率が上がります。

感謝しています。

お時間頂き有難うございました。

（さんま） 2015/06/01(月) 17:48

コメント返信：

[ 一覧(最新更新順) ]

[[20150601143910]] 『フォルダからエクセルファイルデーターのコピー』（さんま） ページの最後に飛ぶ

[[20150601143910]]　『フォルダからエクセルファイルデーターのコピー』（さんま）　ページの最後に飛ぶ