お世話になります。
ファイルの一覧を作成するマクロを作っていますが、
①拡張子を表示させない
②すべてのシートを調べて、セル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
他のサイトでも質問しております。
マルチお許しください。
>他のサイトでも質問しております。
>マルチお許しください。
それなら、そこのリンク先を提示してください。
①拡張子を表示させない
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
http://www.excel.studio-kazu.jp/cgi-bin/kazuwiki2.cgi?mycmd=read&mypage=[[20080610180452]]&mytime=221121
です。
やじゅ様、お返事有難う御座います。
拡張子を表示させないのはもう少し簡単な方法・・・っていうか
ユーザー関数とか使わない方法はないでしょうか?
拡張子はすべてエクセルです。
あと、 If xxxx then OK else NG
のところですが、
If Cells(R40C15)<0,Cells(R40C19)<0 then
でよろしいでしょうか?
>ユーザー関数とか使わない方法はないでしょうか?
提示したリンク先からその部分だけ抜き出せばいいのでは?
ThisWorkbook.Sheets(1).Cells(i, 2) =
Left(sFile, InStrRev(sFile, ".", -1, vbTextCompare) - 1)
>If Cells(R40C15)<0,Cells(R40C19)<0 then
>でよろしいでしょうか?
「どちらか」なら、","でなく「or」ですね
>拡張子を表示させないのはもう少し簡単な方法・・・っていうか
FSOをお使いなら、
GetBaseNameメソッドで用が足りませんかね。
http://msdn.microsoft.com/ja-jp/library/cc428010.aspx
ありがとうございます。できました。
編集 削除