フォルダ名をだすには

解決済

質問者：taktta
質問日時：2008/11/14 16:08
回答数：6件

以下のコードでファイル名一覧がだせる。しかしフォルダ名がでない
フォルダ名をだすには、どうすればいいか。
　sub　macro1（）
Target = InputBox("ディレクトリ名を入力", "ディレクトリの指定", "C:\Windows") Set FS = CreateObject("Scripting.FileSystemObject")
Set Fol = FS.GetFolder(Target)
Set Fil = Fol.Files
ThisWorkbook.Sheets("Sheet1").UsedRange.Delete
'見出しを付ける
ThisWorkbook.Sheets(1).Range("B2") = "ファイル名"
ThisWorkbook.Sheets(1).Range("C2") = "ファイル種別"
ThisWorkbook.Sheets(1).Range("D2") = "最終更新日"
ThisWorkbook.Sheets(1).Range("E2") = "説明"
ThisWorkbook.Sheets(1).Range("B2:E2").Interior.Color = RGB(0, 0, 0)
ThisWorkbook.Sheets(1).Range("B2:E2").Font.Color = RGB(255, 255, 255)
ThisWorkbook.Sheets(1).Range("B2:Es2").HorizontalAlignment = xlCenter
i = 3
For Each Fx In Fil
'ファイル名
sFile = Fx.Name
'ファイル名の書き出し
ThisWorkbook.Sheets(1).Cells(i, 2) = sFile
'ファイル種別
sFType = Fx.Type
'最終更新日時の書き出し
ThisWorkbook.Sheets(1).Cells(i, 3) = sFType
'最終更新日
sLMod = Fx.DateLastModified
ThisWorkbook.Sheets(1).Cells(i, 4) = sLMod
i = i + 1
Next
End Sub

通報する

この質問への回答は締め切られました。

質問の本文を隠す

回答 (6件)

ベストアンサー優先
最新から表示
回答順に表示

No.6ベストアンサー

回答者： imogasi
回答日時：2008/11/15 00:22

下記で動きましたが。

Target = CurDir
Set bk = appexcel.Workbooks.Open(CurDir & "\" & "Book7.xls")
の部分はテストしやすいように我流ですから、適当に変えてください。
エクセルを立ち上げていない
ForEachで繰り回す必要がある
など質のコードには不足しているのでは。
ーーー
ub macro1()
Target = CurDir
MsgBox CurDir
Set FS = CreateObject("Scripting.FileSystemObject")
Set Fol = FS.GetFolder(Target)

Set Fil = Fol.Subfolders
i = 1
Set appexcel = CreateObject("Excel.Application")
Set bk = appexcel.Workbooks.Open(CurDir & "\" & "Book7.xls")
For Each fx In Fil
'MsgBox fx.Name
'サブフォルダ名
sFile = fx.Name
'サブフォルダ名の書き出し

bk.Sheets(1).Cells(i, "B") = sFile
'ファイル種別
sFType = fx.Type
'最終更新日時の書き出し
bk.Sheets(1).Cells(i, "C") = sFType
'最終更新日
sLMod = fx.DateLastModified
bk.Sheets(1).Cells(i, "D") = sLMod
i = i + 1
Next
bk.Close
Set bk = Nothing
Set appexcel = Nothing
End Sub

- 0
- 件

通報する

この回答へのお礼

意図したものが出力できました。
非常に感謝いたします。

通報する

お礼日時：2008/11/17 14:56

No.5

回答者： hallo-2007
回答日時：2008/11/14 19:11

お詫びに、コードの最後に（End Sub と Nextの間に）

Set Fil = Fol.Subfolders
For Each Fx In Fil
'サブフォルダ名
sFile = Fx.Name
'サブフォルダ名の書き出し
ThisWorkbook.Sheets(1).Cells(i, 2) = sFile
'ファイル種別
sFType = Fx.Type
'最終更新日時の書き出し
ThisWorkbook.Sheets(1).Cells(i, 3) = sFType
'最終更新日
sLMod = Fx.DateLastModified
ThisWorkbook.Sheets(1).Cells(i, 4) = sLMod
i = i + 1
Next

を入れて同じ内容をフォルダーに対して実行してみて下さい。
今、試してみました。

- 0
- 件

通報する

この回答へのお礼

動作を確認できました。
どうもありがとうございます。

通報する

お礼日時：2008/11/17 14:58

No.4

回答者： hallo-2007
回答日時：2008/11/14 18:58

No2,No3です。

質問を勘違いしていました。
No1の方のアドバイス参考にしてください。
指定したディレクトリに中にあるサブフォルダの名前を取得したいのですね。
すみません。スルーしてください。

- 0
- 件

通報する

No.3

回答者： hallo-2007
回答日時：2008/11/14 18:50

あれれ？

コードをそのままコピィして
sFile = Fx.Name
'ファイル名の書き出し
ThisWorkbook.Sheets(1).Cells(i, 2) = sFile
の場合　B列に　Book1.xls　と出たのが

sFile = Fx.Path
'ファイル名の書き出し
ThisWorkbook.Sheets(1).Cells(i, 2) = sFile
にしたら
C:\Windows\mydoc\Book1.xls
^^^^^^^^^^^^^^^^^
と出たのですが、この事ではなかったのでしょうか。
ちなみに、
ThisWorkbook.Sheets(1).Cells(i, 6) = Fx.Path
一行入れてもF列に出ましたが。
>このような情報はどうやったら得られますか
まぐれです。

- 0
- 件

通報する

No.2

回答者： hallo-2007
回答日時：2008/11/14 16:46

試しにと思って

sFile = Fx.Name　を
sFile = Fx.Path　に変えたらパスとファイル名が出ますね。
MID関数使ってパスだけにするとかは如何でしょうか？
でもこの場合　フォルダ名は　Targetでは
MsgBox Target で表示されるのはご希望のこととは違いますか。

この回答への補足

sFile = Fx.Name　を
sFile = Fx.Path　

このような情報はどうやったら得られますか

補足日時：2008/11/14 18:05

通報する

- 0
- 件

通報する

この回答へのお礼

回答どうもありがとうございます。
しかし
sFile = Fx.Name　を
sFile = Fx.Path　に変えたらパスとファイル名が出ますね。

とありますが実験してもフォルダ名はでてきませんが、本当にでたのでしょうか。

For Each Fx In Fil
'
sFile = Fx.Path　
'名の書き出し
ThisWorkbook.Sheets(1).Cells(i, 2) = sFile
'ファイル種別
sFType = Fx.Type

ということですよね。