ここから本文です

VBA フォルダ内のエクセルファイル取得について フォルダ構成 指定フォルダ...

mir********さん

2017/10/1010:34:21

VBA フォルダ内のエクセルファイル取得について

フォルダ構成

指定フォルダの中
→エクセルファイル
→ファイルフォルダ
エクセルファイル(.xls)とファイルフォルダ2つが混在


ファイルフォルダの中
→エクセルファイルだけ(.xls)

上記のフォルダ構成で、指定フォルダのファイルフォルダすべてを開き、その中の最新のエクセルファイルだけ開き、特定の処理をさせてその後ファイルを閉じるようなマクロを作成したいのですが上手くいきません。。
ご教示願います。今回はVBA限定でお願い致します。

閲覧数:
90
回答数:
2
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

lin********さん

2017/10/1013:15:09

「VBA」的ではありませんが、

Sub Sample()
Dim gf As Object, so As Object
Dim fl As Object, fi As Object
Dim bk As Workbook
Set so = CreateObject("Scripting.FileSystemObject")
Set gf = so.GetFolder("D:\Programming")
For Each fl In gf.SubFolders
For Each fi In fl.Files
If LCase(so.GetExtensionName(fi.Name)) = "xls" Then
Set bk = Workbooks.Open(fl & "\" & fi.Name)

★★★おやりになりたいこと★★★

bk.Save
bk.Close
Set bk = Nothing
End If
Next fi
Next fl
End Sub

簡単な説明です。

Set so = CreateObject("Scripting.FileSystemObject")

ファイルやフォルダを扱えるようにしています。

Set gf = so.GetFolder("D:\Programming")

今は仮に「D:\Programming」フォルダを処理対象フォルダとしています。

For Each fl In gf.SubFolders

「D:\Programming」の下のサブフォルダを調べています。

For Each fi In fl.Files

そのサブフォルダ内のすべてのファイルを処理します。

If LCase(so.GetExtensionName(fi.Name)) = "xls" Then

もし、拡張子が「xls」なら、

Set bk = Workbooks.Open(fl & "\" & fi.Name)

ファイルを開いています。

bk.Save
bk.Close
Set bk = Nothing

ファイルを上書き保存し、閉じています。

Next fi
Next fl

を、すべてのファイル、すべてのサブフォルダで繰り返しています。

  • 質問者

    mir********さん

    2017/10/1013:42:34

    回答ありがとうございます。
    サブフォルダ内のすべてのファイルを処理ではなく、日時が最新のもの1つだけを抽出したい状況ですので修正頂いてもよろしいでしょうか?

  • その他の返信(3件)を表示

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

質問した人からのコメント

2017/10/10 14:46:17

お二人ともありがとうございました。
今回は起動したlin_nyan36さんをBAとさせていただきます。。

ベストアンサー以外の回答

1〜1件/1件中

kky********さん

2017/10/1011:05:51

サブフォルダのファイル取得は色々な方法があります。一例です。

先頭の
Const fpath As String = "D:\Data"
ここで親フォルダを指定してください。

Sub Sample()
Const fpath As String = "D:\Data"
Dim tbl() As String
Dim fname As String
Dim i As Long
Dim svdate As Date
Dim svname As String
Dim wb As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'フォルダを配列に入れる
ReDim tbl(0)
tbl(0) = fpath
Do
fname = Dir(tbl(i) & "\", vbDirectory)
Do While fname <> ""
If GetAttr(tbl(i) & "\" & fname) And vbDirectory Then
If fname <> "." And fname <> ".." Then
ReDim Preserve tbl(UBound(tbl) + 1)
tbl(UBound(tbl)) = tbl(i) & "\" & fname
End If
End If
fname = Dir()
Loop
i = i + 1
If i > UBound(tbl) Then
Exit Do
End If
Loop
'ファイルを取得
With Worksheets("Sheet1")
For i = 0 To UBound(tbl)
fname = Dir(tbl(i) & "\*.xls", vbNormal + vbHidden + vbReadOnly + vbSystem)
Do Until fname = ""
If FileDateTime(tbl(i) & "\" & fname) > svdate Then
svdate = FileDateTime(tbl(i) & "\" & fname)
svname = tbl(i) & "\" & fname
End If
fname = Dir()
Loop
Next
End With
Set wb = Workbooks.Open(svname)
'処理
MsgBox svname & "に対して処理後保存"
wb.Close SaveChanges:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる