今年の干支 Silver - RightWay 今年の干支

有償ボランティア活動(愛知県瀬戸市・尾張旭市 域内限定)

☆☆ Excel VBA マクロでフォルダの一覧を取得 ☆☆

Excel VBA マクロでフォルダの一覧を取得する、方法について、参考になるホームページを紹介しながら説明します。

(1) Excel VBA マクロの Tips を参考にしながら説明
「Excel VBA マクロ」内のフォルダ「VBA フォルダの一覧を取得」のサブフォルダを取得するサンプルプログラムを解説しなから説明します
Excel VBA マクロ使い方1

(2) VBA フォルダの一覧を取得する
「サブフォルダを取得」のサンプルプログラムを改修しExcelシートへフォルダ名とフォルダパスを出力するプログラムを一緒に作成し実行して動くことを確認します。
◇サンプルプログラム◇
Excel VBA マクロ使い方2

(3) VBA フォルダの一覧を取得する
「サブフォルダを取得」するVBAのサンプルプログラムを作成しました。
◇試作した、プログラム◇
Excel VBA マクロ使い方3

フォルダ一覧のサンプルExcelダウンロード
 

参考:Ⅾドライブの全フォルダをシート「フォルダ一覧」に出力


======================================================================

Sub GetFolder_Main()
'----------------------------------------------------'
' Excelシートへフォルダ名とフォルダパスを出力する
'  ・環境設定: (Microsoft Scripting Runtime)
'  ・シート名: "フォルダ一覧"
'----------------------------------------------------'

On Error Resume Next            ' エラーが発生したら次の行へ移動する

Dim fso As FileSystemObject
Set fso = New FileSystemObject  ' インスタンス化

Dim pfl As Folder

wk_Path = Sheets("フォルダ一覧").Cells(2, 2).Value
Set pfl = fso.GetFolder(wk_Path)  ' 親フォルダを取得

'出力先セルクリアー

 Sheets("フォルダ一覧").Select
 Rows("4:4").Select
 Range(Selection, Selection.End(xlDown)).Select
 Selection.ClearContents
 Range("A4").Select

'親フォルダを取得
i = 4
For Each fl In pfl.SubFolders ' サブフォルダの一覧を取得
    Sheets("フォルダ一覧").Cells(i, 2).Value = fl.Name   ' フォルダの名前
    Sheets("フォルダ一覧").Cells(i, 3).Value = fl.Path   ' フォルダのパス
    i = i + 1
Next

'配下のフォルダを取得
J = 4
wk_Path = Sheets("フォルダ一覧").Cells(J, 3).Value

Do While wk_Path <> ""
   Set pfl = fso.GetFolder(wk_Path) ' 親フォルダを取得
   
   For Each fl In pfl.SubFolders ' サブフォルダの一覧を取得
       Sheets("フォルダ一覧").Cells(i, 2).Value = fl.Name   ' フォルダの名前
       Sheets("フォルダ一覧").Cells(i, 3).Value = fl.Path   ' フォルダのパス
       i = i + 1
   Next
   
   J = J + 1
   wk_Path = Sheets("フォルダ一覧").Cells(J, 3).Value

Loop

' 後始末
Set fso = Nothing

End Sub
 
Sub FolderOpen()
'----------------------------------------------------'
'** 指定したフォルダをエクスプローラーで開く
' (表示したいフォルダ行にカーソルでセット)
'----------------------------------------------------'

Sheets("フォルダ一覧").Select
i = ActiveCell.Row
wk_Folder = Sheets("フォルダ一覧").Cells(i, 3).Value
Shell "EXPLORER.EXE """ & wk_Folder & """", vbNormalFocus
End Sub


======================================================================


以上、「Silver - RightWay」をご利用いただき有難うございます。

シルバーライトウェイ
愛知県 瀬戸市 東松山町

inserted by FC2 system