ファイルの一覧を作成する

解決

K7 2008-06-11 06:06:42 No: 139881

お世話になります。
ファイルの一覧を作成するマクロを作っていますが、
①拡張子を表示させない
②すべてのシートを調べて、セルR40C15とセルR40C19のどちらかに値が入っている場合のみ
一覧に抽出する。

という条件を加えたいのですが、なかなかうまくいきません。
どなたか助けてください。

Sub MakeFileList()

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

他のサイトでも質問しております。
マルチお許しください。

やじゅ 2008-06-11 06:59:19 No: 139882

>他のサイトでも質問しております。
>マルチお許しください。
それなら、そこのリンク先を提示してください。

①拡張子を表示させない
http://www.relief.jp/itnote/archives/002966.php

②すべてのシートを調べて、セルR40C15とセルR40C19のどちらかに
値が入っている場合のみ一覧に抽出する。

下記のような処理をかけば
Dim ws As Worksheet 'ワークシート
For Each ws In Worksheets '全てのシートを調べる
  With ws
    If xxxx then OK else NG
  End With
Next

K7 2008-06-11 07:56:46 No: 139883

http://www.excel.studio-kazu.jp/cgi-bin/kazuwiki2.cgi?mycmd=read&mypage=[[20080610180452]]&mytime=221121
です。
やじゅ様、お返事有難う御座います。

K7 2008-06-11 08:13:46 No: 139884

拡張子を表示させないのはもう少し簡単な方法・・・っていうか
ユーザー関数とか使わない方法はないでしょうか？
拡張子はすべてエクセルです。

あと、 If xxxx then OK else NG

のところですが、
If Cells(R40C15)<0,Cells(R40C19)<0 then
でよろしいでしょうか？

やじゅ 2008-06-11 10:32:14 No: 139885

>ユーザー関数とか使わない方法はないでしょうか？
提示したリンク先からその部分だけ抜き出せばいいのでは？
ThisWorkbook.Sheets(1).Cells(i, 2) =
Left(sFile, InStrRev(sFile, ".", -1, vbTextCompare) - 1)

>If Cells(R40C15)<0,Cells(R40C19)<0 then
>でよろしいでしょうか？
「どちらか」なら、","でなく「or」ですね

もげ 2008-06-11 18:36:16 No: 139886

>拡張子を表示させないのはもう少し簡単な方法・・・っていうか

FSOをお使いなら、
GetBaseNameメソッドで用が足りませんかね。
http://msdn.microsoft.com/ja-jp/library/cc428010.aspx

K7 2008-06-13 06:02:12 No: 139887

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