EXCEL(VBA)で指定フォルダ内の最新ファイル名を取得したい

Question

お世話になります。
指定フォルダ内に何種類か(xls,doc等)のファイルがあり、ファイル名はTitle毎としてあります。
タイトル毎の最新ファイル(TaitleAであれば03のファイル名を、TitleBであれば04)のファイル名を取得したいのですが、どうすれば良いか、詳しい方よろしくお願い致します。
(※当方バージョンは2003です。)
--------------------------------
(フォルダ内)
TitleA01.xls　TitleB01.doc
TitleA02.xls　TitleB02.doc
TitleA03.xls　TitleB03.doc
　　　　　　  TitleB04.doc
--------------------------------

cj_mover · Accepted Answer

こんにちは。

色々ありますが、この手の処理ではもっともベーシックな手法で、
Dir関数をループするやり方です。

ファイル名が「タイトル」から始まるファイルを、
拡張子は無視して、総当たりで検索して、
ファイル名を文字列値としての大小比較をすることで、簡単に、
一番大きな数字が付いたファイルを判別するように書いています。
簡単な記述であることを重視していますので、
　もしも、"TitleA2.xls"とか"TitleA０２.xls"とか
　不規則な命名のファイルが混じっていると、
　"TitleA03.xls"よりも新しい、と判断される
ような書き方を選びましたので、注意してください。
実際の処理の場面でのお求めに対して、もしも不足があるようでしたら、
ご提示のファイル名について、どこまでが具体例なのか
判るような補足を書いてみて下さい。
例示が抽象的過ぎていたりすると、こちらからは、
お役に立てないものしか提示できないのかも知れませんので。


Sub Re8953548G()

Dim sDir As String
Dim sTitleHead As String
Dim sTemp As String
Dim sReturn As String

　　' ' 「指定フォルダ」へのパスをドライブ名から指定
　　sDir = "D:\Work"
　　' ' ファイル名を前方一致で篩に掛ける「タイトル」を指定
　　sTitleHead = "TitleA"

　　' ' Dir関数でファイル名を取得
　　sTemp = Dir(sDir & "\" & sTitleHead & "*")
　　' ' Dir関数をループ
　　Do While sTemp <> ""　'　Dir関数でファイル名を取得し尽したらループ終了
　　' ' ファイル名が「タイトル」で始まるものだけ篩に掛ける
　　　　If sTemp Like sTitleHead & "*" Then
　　　　　　If sTemp > sReturn Then sReturn = sTemp
　　　　End If
　　　　sTemp = Dir()　' ' Dir関数で次のファイル名を取得
　　Loop

　　MsgBox "フォルダ：" & sDir & vbLf & "タイトル：" & sTitleHead & vbLf & "最新：" & sReturn

End Sub

cj_mover · Answer

＃１です。補足コメント拝見しました。

拡張子別に「最終のファイル名を取得したい」ということは理解出来ました。
実は＃１の時点でも、そういうニーズは想定していて実際に書いていたのですが、
それにしては、複数の結果を出力する方法の指定が無かったので、
拡張子別ではない、と判断したのでした。
とりあえず、出力の仕方が解りませんから、
以下の記述に照らして、３通りの扱い方を説明しますので、
そちらで応用なってください。
１）拡張子毎にループした中で、個々の拡張子の最終ファイル名を取得したい場合
　　　　Loop
　　　　MsgBox sReturn　'　←ここ（LoopとNextの間）で sReturn 文字列を
　　Next i
２）一通りループが済んだ後で、配列として最終ファイル名を取得したい場合
　　Next i
　　の後に、arrReturn() 文字列配列を
３）区切られた連続した文字列として最終ファイル名を取得したい場合
　　Next i
　　の後に、MsgBox Join(arrReturn(), ",") 文字列を　（←例はカンマ区切り）


Sub Re8953548Ga()

Dim arrExtension() As String
Dim arrReturn() As String
Dim sDir As String
Dim sTitleHead As String
Dim sTemp As String
Dim sReturn As String
Dim nUB As Long
Dim i As Long

　　' ' 「指定フォルダ」へのパスをドライブ名から指定
　　sDir = "L:\Work"
　　' ' ファイル名を前方一致で篩に掛ける「タイトル」を指定
　　sTitleHead = "TitleA"
　　' ' 拡張子をカンマ区切りテキストで指定　"*.拡張子"文字列の配列
　　arrExtension() = Split("*.xls,*.doc,*.mdb,*.ppt,*.txt", ",")
' ' ■■■■　以上、要指定　■■■■

　　' ' "*.拡張子"文字列の配列のサイズ
　　nUB = UBound(arrExtension())
　　' ' 戻り値を格納する配列変数を再定義
　　ReDim arrReturn(nUB) As String

　　' ' 拡張子の数だけループ
　　For i = 0 To nUB
　　　　sReturn = ""
　　　　' ' Dir関数でファイル名を取得
　　　　sTemp = Dir(sDir & "\" & sTitleHead & arrExtension(i))
　　　　' ' Dir関数をループ
　　　　Do While sTemp <> ""　'　Dir関数でファイル名を取得し尽したらループ終了
　　　　　　' ' ファイル名を文字列値としての大小比較 大きい方をsReturnに記録
　　　　　　If sTemp > sReturn Then sReturn = sTemp
　　　　　　sTemp = Dir()　'　Dir関数で次のファイル名を取得
　　　　Loop
　　　　' ' 出力用の配列に「最新ファイル」の名前を格納
　　　　arrReturn(i) = sReturn
　　Next i

　　MsgBox "フォルダ：" & sDir & vbLf & "タイトル：" & sTitleHead & vbLf _
　　　　　　& "最新：" & vbTab & Join(arrReturn(), vbLf & vbTab)

End Sub

WindFaller · Answer

こんにちは。ご自分で、このようなものを作る時は、コマンドプロンプトなどで、Dir を出してしまい、それをExcelに貼り付けるということもアリだと思います。今回、コマンドプロンプトのDirを使わなかった理由は、私の設定が、一般的な設定ではなかったからです。以下は、Excelで出力も可能ですが、MsgBox にしてあります。拡張子と、日付だけで調べます。なお、ファイル名に関しては、この版では、考慮していません。あくまでも、拡張子とファイルスタンプの最終更新日に対するものです。 '// Sub MainMacro() Dim n As Variant Dim sPath As String sPath = "C:\Temp\" '必ず最後は￥をつける　For Each n In Array(".doc", ".xls", ".txt") 'ここに拡張子を入れてください。　GetLastFile n, sPath 　Next End Sub Sub GetLastFile(Ext As Variant, sPath As Variant) '拡張子　Ext, 調べるパス　sPath 　Dim Fso As Object 　Dim f As Variant 　Dim i As Long, j As Long 　Dim r As Variant 　Dim Ar() As Variant 　Dim buft As Date, bufn As String 　Set Fso = CreateObject("Scripting.FileSystemObject") 　 j = Len(Ext) 　buft = 0 　bufn = "" 　ReDim Ar(1, 1) 　　With Fso 　　　　For Each f In .GetFolder(sPath).Files 　　　　　　If Trim(f.Name) <> "" And _ 　　　　　　StrConv(Right(f.Name, j), vbLowerCase) Like Ext Then 　　　　　　If f.DateLastModified > buft Then 　　　　　　　 buft = f.DateLastModified　'最終更新日　　　　　　　 bufn = f.Name 　　　　　　End If 　　　　　　End If 　　　　Next f 　　End With 　　If bufn <> "" Then 　　　　MsgBox bufn & " " & buft 　　End If End Sub

EXCEL(VBA)で指定フォルダ内の最新ファイル名を取得したい

こんにちは。

＃１です。

こんにちは。

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング