エクセルVBAで質問です

下のコードをみつけました。
質問が二つあります。
１．エラーになります。
実行するとユーザー定義型は定義されていません、と出ます。どこが不具合でしょうか？おなじように記述したつもりですが・・・

２．コードでは、Cドライブの中にあるフォルダに固定されていますが、これをウィンドウを表示させて、検索したいフォルダを選択させて調べるようにできますか？

どうぞよろしくお願いします。


Sub フォルダ取得()

Dim myFSO As New FileSystemObject
Dim myFolders As Folders
Dim myFolder As folder
Dim i As Integer
Set myFolders = myFSO.GetFolder("C:\").SubFolders
i = 1
For Each myFolder In myFolders
Cells(i + 1, 1).Value = myFolder.Name
i = i + 1
Next

End Sub

No.1 ベストアンサー 回答者： suz83238 回答日時： 2008/03/30 14:56

1.New FileSystemObjectでエラーが出るのであれば

Sub フォルダ取得()
Dim myFSO, myFolders, myFolder
Dim i As Integer
Set myFSO = CreateObject("Scripting.FileSystemObject")
Set myFolders = myFSO.GetFolder("C:\").SubFolders
i = 1
For Each myFolder In myFolders
Cells(i + 1, 1).Value = myFolder.Name
i = i + 1
Next
End Sub

2.フォルダを選択
Sub フォルダ取得2()
Dim myFSO, myFolders, myFolder, Fol
Dim i As Integer
Set myFSO = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then Fol = .SelectedItems(1) & "\"
End With
Set myFolders = myFSO.GetFolder(Fol).SubFolders
i = 1
For Each myFolder In myFolders
Cells(i + 1, 1).Value = myFolder.Name
i = i + 1
Next
End Sub

この回答への補足

suz83238さんありがとうございました。完璧なご回答いただき感謝です。一点、お聞きしてから締め切りをさせていただきたいのですが、お願いできるでしょうか？
New FileSystemObjectでエラーというのは、パソコンによってサポートしていなかったりする、というようなことでしょうか？

補足日時：2008/03/30 15:02

No.2 回答者： merlionXX 回答日時： 2008/03/30 15:19

> 実行するとユーザー定義型は定義されていません、と出ます

使用する前に、[プロジェクト]→[参照設定]で Microsoft Scripting Runtime の参照にチェックを入れておいて下さい。
これがされていないＰＣでエラーになります。

> 検索したいフォルダを選択させて調べるようにできますか？

Sub Test()

Dim MyTarget As String
Dim myFSO As New FileSystemObject
Dim myFolders As Folders
Dim MyFolder As folder
Dim i As Integer

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
MyTarget = .SelectedItems(1)
End With

Set myFolders = myFSO.GetFolder(MyTarget).SubFolders
i = 1
For Each MyFolder In myFolders
Cells(i + 1, 1).Value = MyFolder.Name
i = i + 1
Next

End Sub

この回答へのお礼

エラーの原因よくわかりました。こちらのコードも勉強になりました。ありがとうございました。

お礼日時：2008/03/30 17:09