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

解決


K7  2008-06-10 21:06:42  No: 139881  IP: 192.*.*.*

お世話になります。
 ファイルの一覧を作成するマクロを作っていますが、
 ①拡張子を表示させない
 ②すべてのシートを調べて、セル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-10 21:59:19  No: 139882  IP: 192.*.*.*

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

①拡張子を表示させない
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-10 22:56:46  No: 139883  IP: 192.*.*.*

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

編集 削除
K7  2008-06-10 23:13:46  No: 139884  IP: 192.*.*.*

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

あと、 If xxxx then OK else NG 

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

編集 削除
やじゅ  2008-06-11 01:32:14  No: 139885  IP: 192.*.*.*

>ユーザー関数とか使わない方法はないでしょうか?
提示したリンク先からその部分だけ抜き出せばいいのでは?
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 09:36:16  No: 139886  IP: 192.*.*.*

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

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

編集 削除
K7  2008-06-12 21:02:12  No: 139887  IP: 192.*.*.*

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

編集 削除