Excel_Visual Basic Editorについて教えてください

質問

お世話になります。
今、フォルダ名一覧を作るVBを作成しているのですが、フォルダ名一覧＆セル内の文字区切りを同時に定義する事はできるでしょうか？

例えば、
MyDocuments内に”1111_aaaa_ああああ_20061030”という形でたくさんのフォルダがあります。フォルダがたくさんあるため、一覧にて管理したいと思います。それに伴い、一覧にしたフォルダ名を"_"（アンダーバー）で区切って2列目以降のセルに収めたいのですが。。。

(1)フォルダ名一覧（抽出）する方法・・・dir関数
(2)文字を分割する方法(1つのセルのみ）・・・Split関数

一応、上記のようにフォルダ名一覧抽出、文字区切り個々には定義できるのですが、合わせるとうまくいきません。2つ同時に定義する事は可能でしょうか？また、文字区切りをたくさんの行（1列目に入っているフォルダ名一覧全て）をいっぺんに実行したいです。

VBにあまり詳しくないため、教えてください。
よろしくお願いいたします。

【環境】
・WindowsXP
・Excel2003

回答No.3

Yeti21 · ベストアンサー

すみません。フォルダというのを見落としていました。
先のサンプルをベースにすると、以下のような感じです。

Sub test()
Dim wkdir As String
Dim fname As String
Dim spname As Variant
Dim i As Integer
Dim j As Integer

wkdir = "c:\work\test\"
fname = Dir(wkdir, vbDirectory)
Do While fname <> ""
If fname <> "." And fname <> ".." Then
If (GetAttr(wkdir & fname) And vbDirectory) = vbDirectory Then
i = i + 1
j = 0
spname = Split(fname, "_")
For Each x In spname
j = j + 1
Application.ActiveSheet.Cells(i, j) = x
Next
End If
End If
fname = Dir
Loop
End Sub

ちなみに、Application.ActiveSheetを使っているので、シートがアクティブな状態で
マクロを実行してください。
或いは、シート名が"Sheet1"なら次のようにしても良いです。
Application.ActiveSheet.Cells(i, j) = x
のところを
Sheets("Sheet1").Cells(i, j) = x
とする。

※あくまで例として提示していますので、そのまま使う前提では有りません。

お礼

ありがとうございました。

上記を参照し、行ったところ、正常に処理できました！

変更したコード↓
*******************************************************
Sub バックアップ一覧作成()

'変数の宣言
Dim wkdir As String
Dim fname As String
Dim spname As Variant
Dim i As Integer
Dim j As Integer

'フォルダの場所指定
wkdir = "c:\GhostData\"
fname = Dir(wkdir, vbDirectory)

'フォルダ名の取得
Do While fname <> ""
If fname <> "." And fname <> ".." Then
If (GetAttr(wkdir & fname) And vbDirectory) = vbDirectory Then
i = i + 1
j = 0

'フォルダ名区切り（_）
spname = Split(fname, "_")
For Each x In spname
j = j + 1

'実行するセル選択
Sheets("バックアップ一覧").Cells(i + 1, j) = x
Next

End If
End If

'A列全てでフォルダ名区切り実行
fname = Dir
Loop
End Sub
*******************************************************

'で付けたコメントは合っていますでしょうか？

回答No.6

Yeti21

またまたすみません。コメント一箇所だけ訂正です。

'フォルダ名の取得
fname = Dir(wkdir, vbDirectory)

になります。
ついでに以下も説明しておきます。

Do While fname <> ""
上記は、先に書いたように、取得したフォルダ名（fname）が空になるまで繰り返しです。
（loopまで）

ついでに、下記ですが、
If fname <> "." And fname <> ".." Then
フォルダ名を取得すると、"."カレントディレクトリと".."親ディレクトリも含まれますが
これは無関係なので処理しないのということです。

If (GetAttr(wkdir & fname) And vbDirectory) = vbDirectory Then
これは、取得したファイル名が「フォルダ」ならという条件です。

For Each x In spname
これは、「_」で分解した配列がspnameなんですが、その配列要素が存在するだけ
処理を繰り返します。
だいたい、こんなところですね。

回答No.5

Yeti21

何度もすみません。

コメントですが、概ね意味はOKと思いますが、最後の
'A列全てでフォルダ名区切り実行
は
'次のファイル名（フォルダ名）を取得
になると思います。
取得するファイル名が無くなると空値が返り、doループが終了します。

その前の、
'実行するセル選択
は、ニュアンス的には
'セルに「_」で区切られた文字列を順次セット
の方が近いでしょうか。

お礼

コメントの確認ありがとうございました。

VBがあまり詳しくなく、頭を抱えていました。。

何度も何度も本当にありがとうございました。
また何かありましたら、よろしくお願いいたしますm(._.)m

回答No.4

Yeti21

補足への回答を忘れていました。

サンプルでシートにセットしているのは
iが行、jが列を表し、補足の例でいうと
A1を基点として
A B C D
1234 5678 ああ 20061030
5678 1234 いい 20061031

という風になります。

更に下記のように変更すれば、1列目にはファイル名で、2列目以降に分解した各文字列が入ります。

Sub test()
Dim wkdir As String
Dim fname As String
Dim spname As Variant
Dim i As Integer
Dim j As Integer

wkdir = "c:\work\test\"
fname = Dir(wkdir, vbDirectory)
Do While fname <> ""
If fname <> "." And fname <> ".." Then
If (GetAttr(wkdir & fname) And vbDirectory) = vbDirectory Then
i = i + 1
j = 0
Application.ActiveSheet.Cells(i, 1) = fname
spname = Split(fname, "_")
For Each x In spname
j = j + 1
Application.ActiveSheet.Cells(i, j) = x
Next
End If
End If
fname = Dir
Loop
End Sub

dir関数でvbDirectoryがフォルダ指定になりますが、継続するdirではフォルダのみの取得とはならないため、
If (GetAttr(wkdir & fname) And vbDirectory) = vbDirectory Then
で、フォルダのみを処理するようにしています。

回答No.2

noname#22222

Dir()を利用した場合、フォルダとファイルの区別する方法を思い出しませんでした。
そこでファイルシステムオブジェクト版を示しておきます。
質問そのものの核心部には、これでも応えているかと思います。

0ffice2000 Sp3
****************************
0ffice2000
Sp3
============================
FAX
****************************
FAX
============================
My Data Sources
****************************
My
Data
Sources
============================
My Download
****************************
My
Download
============================

次は、このように＜マイドキュメント＞を表示するサンプルコードです。
サブフォルダー以外のファイルは当然のことながら表示対象から除外しています。

Private Sub コマンド0_Click()
　　Dim I　　　　 As Integer
　　Dim J　　　　 As Integer
　　Dim N　　　　 As Integer
　　Dim M　　　　 As Integer
　　Dim fldList() As String
　　Dim fldName() As String

　　fldList() = GetFolderList("D:\xxxxxx")
　　N = UBound(fldList()) - 1
　　For I = 0 To N
　　　　Debug.Print fldList(I)
　　　　Debug.Print "****************************"
　　　　fldName() = Split(fldList(I) & " ", " ")
　　　　M = UBound(fldName()) - 1
　　　　For J = 0 To M
　　　　　　Debug.Print fldName(J)
　　　　Next J
　　　　Debug.Print "============================"
　　Next I
End Sub

fldName() = Split(fldList(I) & "_", "_")

質問のケースでは、とスペースの代わりにアンダーバーで分割する必要があります。

GetFolderList() で、一気にフォルダ名一覧を fldList() に読み込んでいます。
僅か一行で済みますのでルーチンが非常に単純化するのが特徴です。
この場合、Microsoft scripting runtime を参照すせる必要があります。

Public Function GetFolderList(ByVal strDir As String, _
　　　　　　　　　　　　　　　Optional strName As String = "*") As String()
On Error GoTo Err_GetFolderList
　　Dim strFiles As String
　　Dim fso　　　As FileSystemObject
　　Dim fol　　　As Folder
　　Dim sfl　　　As Folders
　　Dim esf　　　As Folder

　　Set fso = New FileSystemObject
　　Set fol = fso.GetFolder(strDir)
　　Set sfl = fol.SubFolders

　　For Each esf In sfl
　　　　strFiles = strFiles & "," & esf.Name
　　Next
Exit_GetFolderList:
On Error Resume Next
　　GetFolderList = Split(Mid(strFiles, 2), ",")
　　Exit Function
Err_GetFolderList:
　　strFiles = ""
　　MsgBox Err.Description & "(GetFolderList)", vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_GetFolderList
End Function

お礼

上記のYeti21さんの回答で解決いたしました。
本当にありがとうございました。

補足

回答ありがとうございます。

．．．私には難しいみたいです。
上記のコードが何がなんだか分かりません。。
勉強不足でごめんなさい。

もう少し、詳しく(簡単に？）教えていただけると嬉しいです。
コード途中の説明が少し欲しいです。

よろしくお願いいたします。

回答No.1

Yeti21

勘違いでなければ、こういうことでしょうか？
簡単なサンプルなので、適当に環境に合わせて見てください。

Sub test()
Dim fname As String
Dim spname As Variant
Dim i As Integer
Dim j As Integer

fname = Dir("c:\work\test\")
Do While fname <> ""
i = i + 1
j = 0
spname = Split(fname, "_")
For Each x In spname
j = j + 1
Application.ActiveSheet.Cells(i, j) = x
Next
fname = Dir
Loop
End Sub

補足

早速の回答ありがとうございます。

上記のサンプルのDirの参照先を変更し、テストしてみたのですが、うまくできません。
実行時にエラーが出るわけではなく、実行はされているようなのですが、セルに一覧が表示されません。

上記のVBの場合、（c\work\test内のフォルダ一覧を表示させ、アンダーバーで区切る）
A B C D E
1 1234_5678_ああ_20061030 1234 5678 ああ 20061030
2 5678_1234_いい_20061031 5678 1234 いい 20061031
・
・
・
となるのでしょうか？
fnameはFileNameと一緒だとすると、fnameでフォルダ名は拾ってこられるのでしょうか？

教えてください。
よろしくお願いいたします。