VB6のFileSystemObjectを使って、サブフォルダの中のファイルを取得したいのです。

For Each ~ Next 文などをつかっていろいろやっているのですが、どうしてもサブフォルダ以降のサブサブフォルダから下が取得できません。
誰か教えてください。

A 回答 (2件)

ちょっと前にやったことがあるので参考になれば・・・。



Private Sub GetFileCollection(ByRef sDirName As String, ByRef sFileCol As Collection)
  Dim FSysObj As Scripting.FileSystemObject
  Dim aFolder As Scripting.Folder
  Dim ChildFolder As Scripting.Folder
  Dim aFile As Scripting.File
  Dim i As Long

  On Error GoTo EXCEPTION_SECTION

  Set FSysObj = New Scripting.FileSystemObject
  Set aFolder = FSysObj.GetFolder(sDirName)
  If (aFolder.Attributes And System) = System Then
    Exit Sub
  End If

  For Each aFile In aFolder.Files
    sFileCol.Add aFile.Path
  Next aFile

  If aFolder.SubFolders.Count > 0 Then
    For Each ChildFolder In aFolder.SubFolders
      Call GetFileCollection(ChildFolder.Path, sFileCol)
    Next ChildFolder
  End If

  Exit Sub

EXCEPTION_SECTION:
  MsgBox "[" & Err.Number & "]" & Err.Description, vbExclamation + vbOKOnly, "エラー"
  Exit Sub

End Sub
    • good
    • 0

http://www.okweb.ne.jp/kotaeru.php3?q=38626
の回答を参考にしてやって下さい。

「再帰」っていうのを使えば、結構簡単に取得できます。
先のアルゴリズムを簡略化して書くと、
1:引数で指定されたフォルダに含まれるファイルの一覧を取得する。
2引数で指定されたフォルダに含まれるフォルダの一覧を検索する。
3:見つかったフォルダを引数にして自分自身を呼び出す。

のようになっています。「なぜこれでうまく行くのか」はちょっと説明しづらいですが、とにかくこれでうまく動くはずです。(動かなかったら補足してください。)

参考URL:http://www.okweb.ne.jp/kotaeru.php3?q=38626
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aと関連する良く見られている質問

QExcel VBA のFor Each ・・・ Next について

配列に数字(特段数字でなくても)入れたいのですが、以下のように書きました。

Sub test()
Dim x As Variant
Dim m(1 To 10) As Integer

For Each x In m
x.Value = 100
Next
Stop

End Sub

Stopでとめてmを確認するとすべて0です。どうしてなのでしょうか。

配列ではなく

Sub test()
Dim x As Variant

For Each x In range("a1:a10")
x.Value = 100
Next

End Sub

とするとA1:A10には100が入ります。

この差がいまいちわからなくて、

もちろんFor ・・・ Nextで簡単に入れられるのは承知しています。

補足ですが
また最初はx.valueの.valueをつけていなかったのでセルにも反映されませんでしたが.valueをつけると入りました。

配列に数字(特段数字でなくても)入れたいのですが、以下のように書きました。

Sub test()
Dim x As Variant
Dim m(1 To 10) As Integer

For Each x In m
x.Value = 100
Next
Stop

End Sub

Stopでとめてmを確認するとすべて0です。どうしてなのでしょうか。

配列ではなく

Sub test()
Dim x As Variant

For Each x In range("a1:a10")
x.Value = 100
Next

End Sub

とするとA1:A10には100が入ります。

こ...続きを読む

Aベストアンサー

前者は、
> x.Value = 100
ではなく、
> x = 100

ですよね?
これは、
-------------------------------
For I=LBound(m) To UBound(m)
x = m(I)
x = 100
Next
-------------------------------
と同じ様な動作です。
変数xを上書きしているだけで、mには影響がありません。

後者は、同様に、
--------------------------------
For I=1 To 10
Set x = range("a1:a10").Cells(I,1)
x.Value = 100
Next
--------------------------------
と同じ様な動作です。普通に変更されます。

QFor Each ~ Next の動作

コレクションの操作をするときなどに、

For tmp in testCol
  List1.Add tmp
Next

ってな感じでFor Each文をつかいますよね。
あれって、

For i = 0 To testCol.Count
  List1.Add testCol.Item(i)
Next i

と書くのに比べ、びっくりするほど処理が速いですよね。
いったい、どんな違いがあるのでしょうか。

Aベストアンサー

データ構造のせいだと思います。

コレクションの中に、「このデータの次のデータは何番地から、前のデータは何番地から」って、メモリ上のアドレスの情報が入っているのでしょう。
FOR EACHでは、この情報を参照して高速に次のデータのアドレスを取得しているのだと思います。

それに対して、testCol(i)の方は、データのアドレスを知るのに「コレクションのi番目のデータのアドレスを検索すれ~」って命令をいちいち発しているんだと思います。

以上、単なる推測ですが、多分こんな感じだと思います。

QFileSystemObjectでフォルダ名取得

http://officetanaka.net/excel/vba/filesystemobject/filesystemobject.htm


このページにファイル名から、拡張子やドライブ名などを出力する方法が書かれていますが
ファイルが入っているフォルダ名を取得するコマンドはございますでしょうか?

例えば、

C:\xxxx\yyyy.txt
の場合、
C:\xxxx\

を取得したいのですが、コマンドはありますか?

Aベストアンサー

参考に
With CreateObject("Scripting.FileSystemObject")
  MsgBox .GetParentFolderName("C:\xxxx\yyyy.txt")
End With

QFor...Next文をつかってボタン1を、押したら3.2.1.0.と順にカウントダウンするメッセー

For...Next文をつかってボタン1を、押したら3.2.1.0.と順にカウントダウンするメッセージボックスが表示されるようなプログラムのコードを書きなさい。という課題が出たのですがわかりません。よろしくお願いします

Aベストアンサー

以下のようにして下さい。
-----------------------------------
Private Sub CommandButton1_Click()
Dim i As Long
For i = 3 To 0 Step -1
MsgBox (i)
Next
End Sub
-----------------------------------
CommandButton1はあなたのボタン1の名前です。
デフォルトではCommandButton1になっています。あなたの環境にあわせてください。
ボタンの名前_Click()というプロシージャ名になっていればOKです。

QFileSystemObject & For Eachループで・・・

皆様こんにちは!

VBAでプログラムを作っていて不明点があり困っています。
FileSystemObjectを使用してあるフォルダにあるサブフォルダ内のすべての
ファイルをコピーしフォルダを削除する処理を作成しています。


Set objFolder = objFs.GetFolder("C:\TEST")

For Each objSubFolder In objFolder.subfolders 'TESTフォルダ内にあるサブフォルダ獲得
For Each objFile In objSubFolder.Files 'サブフォルダ内のファイル獲得
ON Error Go To CopyErr
objFs.CopyFile(objFile.Path,"コピー先名") 'ファイルコピー処理
ON Error Go To 0
Set objFile = Nothing
Next
Set objSubFolder = Nothing
Next

Set objFolder = Nothing
objFs.DeleteFolder("C:\TEST") 'TESTフォルダ削除
Set ObjFs = Nothing
exit sub

CopyErr:
Set objFile = Nothing
Set objSubFolder = Nothing
Set objFolder = Nothing
objFs.DeleteFolder("C:\TEST")
Set ObjFs = Nothing
end sub

上の様な処理でファイルのコピーでエラーが発生し
CopyErrへ飛んだ場合、TESTフォルダの削除時に
”書込みできません”とエラーが発生し
TESTフォルダが削除できません(その中のサブフォルダは削除されます)。
正常にFor Each文を抜けた場合は問題なく削除するので解せません。
For EachからはGo To,Exit等で抜けるとまずいのでしょうか?
上の様な処理を作成しようと思えば、Dirを使用した方がいいのでしょうか?
(Nothingの処理は元々なかったのですが、
この現象が出たため試しにつけてみたものです。)

どなたかアドバイスをお願い致します。

皆様こんにちは!

VBAでプログラムを作っていて不明点があり困っています。
FileSystemObjectを使用してあるフォルダにあるサブフォルダ内のすべての
ファイルをコピーしフォルダを削除する処理を作成しています。


Set objFolder = objFs.GetFolder("C:\TEST")

For Each objSubFolder In objFolder.subfolders 'TESTフォルダ内にあるサブフォルダ獲得
For Each objFile In objSubFolder.Files 'サブフォルダ内のファイル獲得
ON Error Go To CopyErr
objFs.CopyFile(objFile.Path,"コピー先名"...続きを読む

Aベストアンサー

かなり自信がありませんが・・・・勝手な推測です・・・

おそらくVBのバグだと思います。
FSOは内部でファイルの存在チェックを行っておりますが、きっとうまく開放してないのだと思います。

それ以前に気になったのですが、エラー処理で削除を走らせていますよね?
これはコーディング的にあまりよくないと思います。

特に現在のロジックでエラーに飛ぶ処理は、「コピーの失敗」という状況であり、コピーもできないのに削除というアクションをおこそうとしています。これはVBのバグをおこしやすいプログラムに見えます。
このようなエラーで飛んだ場合は、あくまでオブジェクトの初期化や、フラグの制御など以外の処理をしないように努めたほうが健全だと思います。それを一つの関数として、そのステータス次第で処理を分岐したほうがよいと思います。


サンプルを載せておきます。
ちなみに私の環境(WIN2000SP3/VB6SP5)ではステップ実行だと、なぜか失敗します。


Private Sub Command1_Click()
  Const DEF_DIR As String = "C:\TEST"

  Dim objFs    As FileSystemObject
  Dim blnFlg   As Boolean
  
  Set objFs = New FileSystemObject
  
  blnFlg = funcCopy(objFs, DEF_DIR)
  If Not blnFlg Then
    Debug.Print "失敗"
  End If
  Call objFs.DeleteFolder(DEF_DIR)
End Sub

Private Function funcCopy(objFs As FileSystemObject, inFolderPath As String) As Boolean
  On Error GoTo PGMERR
  
  Dim objFolder    As Folder
  Dim objSubFolder  As Folder
  Dim objFile     As File
  
  Set objFolder = objFs.GetFolder(inFolderPath)
  
  For Each objSubFolder In objFolder.SubFolders
    For Each objFile In objSubFolder.Files
      Call objFs.CopyFile(objFile.Path, "コピー先名")
      GoTo PGMERR
    Next
  Next
  
  funcCopy = True
PGMEND:
  Set objFile = Nothing
  Set objSubFolder = Nothing
  Set objFolder = Nothing
  Exit Function
PGMERR:
  funcCopy = False
  GoTo PGMEND
End Function

かなり自信がありませんが・・・・勝手な推測です・・・

おそらくVBのバグだと思います。
FSOは内部でファイルの存在チェックを行っておりますが、きっとうまく開放してないのだと思います。

それ以前に気になったのですが、エラー処理で削除を走らせていますよね?
これはコーディング的にあまりよくないと思います。

特に現在のロジックでエラーに飛ぶ処理は、「コピーの失敗」という状況であり、コピーもできないのに削除というアクションをおこそうとしています。これはVBのバグをおこしやすいプロ...続きを読む


人気Q&Aランキング

おすすめ情報