| |
ＯＳによりフォルダの位置が異なるので、適当に変更して下さい。
Ａ列のセルにフォルダ名が抽出されます。
Private Sub CommandButton1_Click()
Dim myPath As String
Dim myFolder As String
Dim C As Long '行カウンタ
myPath = "C:\" '検索フォルダを指定
Range("A1").Value = "「" & myPath & "」のフォルダ名"
C = 2
myFolder = Dir(myPath, vbDirectory)
Do While myFolder <> "" '取得した名前が空欄でない間繰り返し
'現在のフォルダと親フォルダでなければ
If myFolder <> "." And myFolder <> ".." Then
'取得した名前がフォルダなら
If (GetAttr(myPath & myFolder) And vbDirectory) = vbDirectory Then
Cells(C, 1).Value = myFolder '取得したフォルダ名をセルに代入
C = C + 1
End If
End If
'フォルダ名を取得する
myFolder = Dir
Loop
End Sub
|
|
