ファイル名に今日の日付とキーワードが入ったファイルを開く

今日の日付とキーワード(この場合は「kuma」)が入ったファイルを開き、一番左にあるシートのA1セルの文字を、msgboxで表示するコードです。
このマクロを書いたファイルと同じ場所にあるファイルが対象です。

尚、ファイルを探す方法は、エクセルレジェンドの田中先生のマクロを参考にさせていただきました。
ファイルの一覧を取得する

Sub file_open()
    Dim path As String, buf As String, keyword As String
    
    path = ThisWorkbook.path & "\"
    buf = Dir(path & "*xls*")
    keyword = "kuma" 'キーワード
  
    '下記、和暦か西暦かお好きな方を選んでください。いらない行は消すか、
    'コメントアウト(文の頭に「'」を入力)してください
    Dim todays_date As String
    todays_date = Format(Now(), "eemmdd")         '今日の日付 和暦 例:040101と表示
    todays_date = Format(Now(), "ggge年m月d日")   '今日の日付 和暦 例:令和4年1月1日と表示
    todays_date = Format(Now(), "yyyymmdd")       '今日の日付 西暦 例:20220101と表示
    todays_date = Format(Now(), "yyyy年m月d日")   '今日の日付 西暦 例:2022年1月1日と表示
   
    Dim cnt As Long, wb As Workbook
    cnt = 0
    Do While buf <> ""
        If buf Like "*" & todays_date & "*" & keyword & "*" Then
            
            Set wb = Workbooks.Open(Filename:=path & buf)
            
            MsgBox wb.Name & "ファイルがありました。一番左にあるシートのA1セルの値は、「" & _
            wb.Worksheets(1).Range("A1").Value & "」です。"
            
            cnt = 1
            
            '何も変更せず、開いたブックを閉じます。もし開いたままにしたい場合は、
            '下記3行をコメントアウトしてください。
            Application.DisplayAlerts = False
            wb.Close
            Application.DisplayAlerts = True
            
            Exit Do  '一ファイルだけで良ければループを抜けてください。
        End If
        buf = Dir()
    Loop
    
    If cnt = 0 Then
        MsgBox "ファイルはありませんでした"
    Else
        MsgBox "終わります"
    End If
        
    Set wb = Nothing
End Sub

記事は以上になります。
最後までご覧いただき、ありがとうございました。

おすすめの記事