フォルダ名を日付で管理（2002-08-22）していて、中身にはその日にとったデータ（0822−信号１）
があり、ファイルの検索方法として、現在の日付から2002-08-22の日付のフォルダ内まで検索すると
いう方式を作りたいのですが、方法がわかりません。
　日付を現在から指定した日付まで、-1ずつカウントダウンしていく方法っていうのは取れるのです
か？
方法を教えてくださいっ！よろしくお願いします♪

回答では、ありません。

前回の検索方法は解決されたのですか？
解決されたのであれば、お礼又は結果報告して下さい。
同じ方が、同じようなタイトルで質問されると紛らわしいかと思います。
関連で続けて、質問された方が解答する人も解り易いかと思います。

前回教えていただいたようにここの検索についてやってみたんですが、
うまく出来なかったです。それで今回こういう方法でやろうと乗せました。
返答せずにすいませんでした。

こんなカンジでいいですか？
フォームにTextとList足したら動くとは思います。
------------------------------------------------------------
Option Explicit
Option Base 1

Private Const Mpath = "C:\"

Private fList() As Long
Private ItemCount  As Long
Private Nowdate As Date

Private R As Long
Private msg As String

Private Sub Command1_Click()
Dim datetmp As Date

Dim fPath As String
Dim fname As String

Dim i As Long

On Error GoTo ERLABEL

Nowdate = CDate(Text1.Text)
ItemCount = 0
For i = 0 To 31 '遡る日　３１日
    datetmp = Nowdate - i
    fPath = Mpath + Format$(datetmp, "yyyy-mm-dd") + "\"
    fname = Dir$(fPath, vbDirectory)
        
    Do While fname <> ""
        If fname <> "." And fname <> ".." Then
            If (GetAttr(fPath & fname) And vbDirectory) = vbNormal Then
                List1.AddItem fname
                ItemCount = ItemCount + 1
                ReDim Preserve fList(ItemCount)
                fList(ItemCount) = i
            End If
        End If
        fname = Dir
    Loop
Next i

Exit Sub
ERLABEL:
    msg = "日付ちゃうねん。"
    R = MsgBox(msg, vbOKOnly)
End Sub

Private Sub List1_Click()
msg = Format$((Nowdate - fList(List1.ListIndex)), "yyyy-mm-dd") + "\" + L
ist1.Text
R = MsgBox(msg, vbOKOnly, "選択したファイルのパス")
End Sub

ありがとうございます！参考にしますっ
出来たら、報告しますっ♪

またまたすいません。助言いただきたいです。ファイルシステムオブジェクトを使いたいと
思い、作ろうとしましたが使い方がよくわかりません。下記のようなプログラムで、MyFile
とファイルNO2が一致したら、そのファイルの中身を見るという形にしたかったのですが、ど
う書けばよろしいでしょうか？'Do While fname <> "" と書いた所からさっぱり分か
らなく
なってしまいました（汗）よろしくお願いします♪

'***** フォルダ検索システム開始 **************************** フォルダ名例 2002-08-22
Option Explicit
Option Base 1

Private Const Mpath = "C:\DATA\"
Private R As Long
Private msg As String

Private Sub Command1_Click()
    Dim ファイルNO1 As String
    Dim ファイルNO2 As String
    Dim ファイル日付 As String
    Dim ファイル日付 As Integer
    Dim 月 As String
    Dim 日 As String
    Dim 年 As String
    Dim 西暦 As String
    Dim 日付 As Variant    
    Dim fPath As String
    Dim fname As String
    Dim i As Long
    Dim MyFile As String    
    Dim fs, f, f1, fc, s '*******test

On Error GoTo ERLABEL
    
    ファイルNO1 = InputBox("ファイルNOを入力してください", "ファイル検索"
)　'固定11桁(例○○○○○
822データ)
    ファイルNO2 = CStr(ファイルNO1)
    ファイル日付 = Mid(ファイルNO2, 6, 3)    
    年 = Mid(ファイルNO2, 5, 1)
    月 = Left(ファイル日付, 1)
    日 = Right(ファイル日付, 2)

    Select Case 年
        Case "A": 西暦 = CStr("2000")
        Case "B": 西暦 = CStr("2001")
        Case "C": 西暦 = CStr("2002")
        Case "D": 西暦 = CStr("2003")
        Case "E": 西暦 = CStr("2004")
        Case "F": 西暦 = CStr("2005")
        Case "G": 西暦 = CStr("2006")
        Case "H": 西暦 = CStr("2007")
        Case "I": 西暦 = CStr("2008")
        Case "J": 西暦 = CStr("2009")
        Case "K": 西暦 = CStr("2010")
        Case "L": 西暦 = CStr("2011")
        Case "M": 西暦 = CStr("2012")
        Case "N": 西暦 = CStr("2013")
        Case "O": 西暦 = CStr("2014")
        Case "P": 西暦 = CStr("2015")
        Case "Q": 西暦 = CStr("2016")
        Case "R": 西暦 = CStr("2017")
        Case "S": 西暦 = CStr("2018")
        Case "T": 西暦 = CStr("2019")
        Case "U": 西暦 = CStr("2020")
        Case "V": 西暦 = CStr("2021")
        Case "W": 西暦 = CStr("2022")
        Case "X": 西暦 = CStr("2023")
        Case "Y": 西暦 = CStr("2024")
        Case "Z": 西暦 = CStr("2025")
    End Select
    
    Select Case 月
        Case "1", "2", "3", "4", "5", "
;6", "7", "8", "9": 月 = CStr("0" & 月)
    End Select
    
日付 = CStr(西暦 & "-" & 月 & "-" & 日)
Text5.Text = 日付

On Error GoTo ERLABEL

fPath = Mpath + 日付 + "\"
fname = Dir$(fPath, vbDirectory)
MyFile = Dir((fPath & "*.TXT"), vbNormal)

If Right(MyFile, 6) = CStr("-1" Or "-2" Or "-3" Or "-4&quo
t;) & ".txt" Then
    MyFile = Left(MyFile, Len(MyFile) - 6)
End If

'Do While fname <> ""  
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(MyFile)
    'Set fc = f.Files
    Set fc = f.GetFile(MyFile)
    
    For Each f1 In fc
        List1.AddItem MyFile
    Next

If MyFile <> ファイルNO2 Then
R = MsgBox("ファイルは存在しませんよっ！", vbOKOnly, "検索結果")
End If
Exit Sub

ERLABEL:
msg = "ファイルNOは大文字で入力してねっ♪"
R = MsgBox(msg, vbOKOnly)

End Sub
'***** フォルダ検索システム終了 *****

ありがとうございました！おかげで出来ました！