EXCEL VBAでフォルダ操作をしたい

質問

どなたか、お知恵をお貸し下さいませ。

フォルダ(A)の中に、さらにフォルダがいくつかあり
その中にあるフォルダを、順番に開く処理がしたいのです。

「フォルダ選択」を表示させて、そこで選択したフォルダを開くという方法で行なっていたのですが、フォルダの数が多すぎて、それも大変で・・・。

順番に自動的に開いてくれるようにすることはできないものなのでしょうか？

中のフォルダの名前は連番ではありません。
連番にする必要があるのでしたら、その方法もお教え下されば有難いです。（フォルダ名は変更しても支障ありません）

説明がわかりにくいかもしれませんが、よろしく御願いします。

回答No.6

takibo · ベストアンサー

おはようございます。takibo です。

No.5のコードを書いたBookに再度、VBEの参照設定 Microsoft Scripting Runtime のチェックを入れてください。
参照設定はBook毎に設定されます。

お礼

takiboさーーーーん！出来ましたぁ！！！
ほんとにほんとに、お世話をおかけしてすみませんでした。
とてもとても助かりました！
ここに表示されたフォルダのパスを利用して
なんとかファイル処理をして行こうと思います。

これからも宜しく御願い致します。（もう嫌やって？！）

回答No.5

takibo

何度もすみません。一部間違っていました。こちらに置き換えてください。

Sub サブフォルダ取得()
Dim パス As String
Dim objA As Object
Dim objF As Object
Dim myFSO As New FileSystemObject
Dim myFld As Folder
Dim i As Integer
　　Set objA = CreateObject("Shell.application")
　　Set objF = objA.BrowseForFolder(0, "フォルダを選択してください", 0)
　　If Not objF Is Nothing Then
　　　　パス = objF.items.Item.Path
　　End If
　　If パス = "" Then
　　　　Exit Sub
　　Else
　　　　If Right(パス, 1) <> "\" Then
　　　　　　パス = パス & "\"
　　　　End If
　　End If
　　Sheets("sheet1").Cells.ClearContents
　　Range("A1").Select
　　i = i
　　With myFSO.GetFolder(パス)
　　　　For Each myFld In .SubFolders
　　　　　　i = i + 1
　　　　　　Cells(i, 1).Value = myFld.Name
　　　　　　Cells(i, 2).Value = パス & myFld.Name & "\"
　　　　Next
　　End With
End Sub

補足

takiboさん、たびたびお世話をおかけしてすみません。

当方のOSはWindows2000 professional
Excelは2002、Visual Basicは6.0（念の為）です。

お送り頂いたコードで試してみましたが
「Dim myFSO As New FileSystemObject」のところで
「コンパイルエラー：ユーザー定義型は定義されていません」 と出てしまいます。

やはり、バージョンによって出来ないとかが関係してるのでしょうかねー？

こうなると、私には全くさっぱりわからない範疇になってしまってます…。

回答No.4

takibo

はじめに伺うべきでしたがOSとExcelのバージョンは何でしょうか？
こちらはWinXP/Excel2002での動作確認になります。

とりあえず、先程までのコードをすっかり置き換えてください。

Sub サブフォルダ取得()
Dim パス As String
Dim objA As Object
Dim objF As Object
Dim myFSO As New FileSystemObject
Dim myFld As Folder
Dim i As Integer
　　Set objA = CreateObject("Shell.application")
　　Set objF = objA.BrowseForFolder(0, "フォルダを選択してください", 0)
　　If Not objF Is Nothing Then
　　　　パス = objF.items.Item.Path
　　End If
　　If パス = "" Then
　　　　Exit Sub
　　Else
　　　　If Right(パス, 1) <> "\" Then
　　　　　　Worksheets(1).Range("C5").Value = パス & "\"
　　　　Else
　　　　　　Worksheets(1).Range("C5").Value = パス
　　　　End If
　　End If
　　Sheets("sheet1").Cells.ClearContents
　　Range("A1").Select
　　i = i
　　With myFSO.GetFolder(パス)
　　　　For Each myFld In .SubFolders
　　　　　　i = i + 1
　　　　　　Cells(i, 1).Value = myFld.Name
　　　　　　Cells(i, 2).Value = パス & myFld.Name & "\"
　　　　Next
　　End With
End Sub

これなら存在するものから選択しているのでパスが存在しないということにはまずなり得ません。
ただし、Ｃドライブ内を前提としているのでXPのデスクトップ上のフォルダは取得できませんのでご注意下さい。

[マイコンピュータ]-[C:]-[A] とすすむと以下のフォルダも表示されますが
[A]を選択した状態で OK を押してください。

回答No.3

takibo

エラーの内容から考えられるのは、入力したパスが間違っているという場合です。
パスは半角/全角が明確に区別されます。
（アルファベットの大文字/小文字は区別されません。）

C:\ ←ここまでは絶対に半角です。それ以降は当然任意になります。

それから、末尾は必ず「\」になるようにしてください。

コードには初期値として全て半角で「C:\A\」としましたが必要に応じて入力しなおしてください。
フォルダ(A)が常に固定であればコードを変更してください。

お礼

takiboさん！本当に何度もありがとうございます。
でも、やはり同じエラーになってしまいます。
ご指摘いただいた所はすべて確認しました。

>C:\ ←ここまでは絶対に半角です。それ以降は当然任意になります。

はい、半角にしています。

>それから、末尾は必ず「\」になるようにしてください。

はい、「\」で終わらせています。

>コードには初期値として全て半角で「C:\A\」としましたが必要に応じて入力しなおしてください。
フォルダ(A)が常に固定であればコードを変更してください。

はい、「A」は任意のフォルダ名でしたので、
実際のフォルダ名に、コードを変更しました。

こんな、ド素人のためにすみません。
自分なりに頑張ってみますが、もしお時間よろしければ
急ぎませんので、ご教授お願いします。

回答No.2

takibo

No.1 です。補足拝見しました。
補足の情報をもとに、使えそうなコードを考えてみました。下記のコードを標準モジュールに記載してください。

--------------ここから--------------

Sub サブフォルダ取得()
Dim myFSO As New FileSystemObject
Dim myFld As Folder
Dim i As Integer
　　パス = InputBox("調べたいフォルダを絶対パスで入力してください。", "ファイル一覧", "C:\A\")
　　Sheets("sheet1").Cells.ClearContents
　　Range("A1").Select
　　i = i
　　With myFSO.GetFolder(パス)
　　　　For Each myFld In .SubFolders
　　　　　　i = i + 1
　　　　　　Cells(i, 1).Value = myFld.Name
　　　　　　Cells(i, 2).Value = パス & myFld.Name & "\"
　　　　Next
　　End With
End Sub

--------------ここまで--------------

このコードを実行する前にVBEでの設定が必要になります。
VBE画面で [ツール(T)]-[参照設定(R)] とすすみ、Microsoft Scripting Runtime にチェックを入れ、OK を押してください。

設定後、このマクロを実行すると sheet1 のＡ列にフォルダ(A)内にあるフォルダ名の一覧が、Ｂ列にパスが表示されます。
あとはこれを使って作業マクロを組んでください。

参考URLにあるファイルでは、指定フォルダ以降のサブフォルダ及びファイル名等の情報を一覧で取得できます。
フォルダの階層やファイル名・ファイル数が一定ではない場合はこちらの方が有効です。

参考URL：

http://www.atmarkit.co.jp/fwin2k/win2ktips/310filelist/filelist.html

お礼

何度もご親切に本当にありがとうございます！

書いて頂いたコードを標準コードに貼り付けてみましたが
「With myFSO.GetFolder(パス)」のところで
「パスが見つかりません」と、止まってしまいました。

まだまだ未熟ですので、お恥ずかしながらどこをどう直せばよいものか頭を悩ませているところです。
わざわざ参考URLも載せて頂いてますことですので
それらを参照させて頂き、頑張ってみようと思います。

貴重なお時間、ありがとうございました。

回答No.1

takibo

Excelからの操作ということでしょうか？開いた後、どういう作業をするのでしょうか？
フォルダを開いてから何をするのかによって違ってくると思います。
フォルダ内のファイルを操作するのであれば、フォルダを開く必要はありませんよね。

あるフォルダ内に存在するフォルダ名の一覧を作成するコードです。

Sub フォルダ一覧作成()
　　場所 = Sheets("sheet1").Range("A1").Value
　　FNAME = Dir(場所, vbDirectory)
　　i = 1
　　Do While FNAME <> ""
　　　　Sheets("sheet1").Cells(i, 2).Value = FNAME
　　　　FNAME = Dir()
　　　　i = i + 1
　　Loop
End Sub

sheet1 の A1 にフォルダ(A)のパスを入力【例：C:\test\ 】して実行すると
B列 にフォルダ(A)内に存在するフォルダの一覧を作成します。

補足

早速ありがとうございます。
説明が不十分で申し訳ありません。

おっしゃる通り、フォルダ内のファイルを操作したいのですが、フォルダ数が多い為、「C:\フォルダ名\ファイル名」と都度指定しなくても順に処理してくれる方法がないかと模索中です。

C:\Ａ\20050801\a
C:\Ａ\20050801\b
C:\Ａ\20050801\c
C:\Ａ\20050802\a
C:\Ａ\20050802\b
C:\Ａ\20050802\c
C:\Ａ\20050803\a
C:\Ａ\20050803\b
C:\Ａ\20050803\c
C:\Ａ\20050805\a
C:\Ａ\20050805\b
C:\Ａ\20050805\c
・
・
・
このような形で保存されているa,b,c,a,b,c,a,b,c,a,b,c・・・のファイルを処理したいのです。

フォルダ内のファイル名が同じである為、一度に開くことができないのもネックではないかと・・・

わかりづらくてすみません。