トップ　>　汎用コード　>　ファイル名に日付を追加

'------------------------------------------------------------------------------
' 選択したファイルの名前に日付を追加するマクロ
'------------------------------------------------------------------------------
' ファイルを開くダイアログボックスで選択したファイルの名前に日付を追加します
' ダイアログボックスでは複数のファイルを一度に選択できます
'［作成日］2021/12/21　［更新］2023/05/20
'------------------------------------------------------------------------------
Sub AddDateToFileName()

    'ファイルを選択
    Dim varFilesName As Variant 'ファイル名格納
    varFilesName = Application.GetOpenFilename("全てのファイル,*.*", , "ファイル選択", , True)
    If VarType(varFilesName) = vbBoolean Then Exit Sub
    
    '日付取得
    Dim strDate As String       '日付を格納
    strDate = "_" & Format$(Date, "yyyymmdd")

    'ファイル名に日付を追加
    Dim varName         As Variant  '現在のファイル名（ファイルパスを含む）格納用
    Dim strNewName      As String   '新しいファイル名格納用
    Dim lngCommPos      As Long     'コンマの位置格納用
    Dim lngTimesCount As Long       'ファイル名変更実施回数
    Dim lngErrorCount   As Long     'エラー回数
    On Error Resume Next
    For Each varName In varFilesName
        lngCommPos = InStrRev(varName, ".")
        If 0 < lngCommPos Then
            '新しい名前を作成
            strNewName = Left$(varName, lngCommPos - 1) & strDate & Mid$(varName, lngCommPos)
            
            'ファイル名を変更
            Name varName As strNewName
            
            '変更実施回数を記録
            lngTimesCount = lngTimesCount + 1
            
            'エラーの場合はエラー回数を記録
            If Err.Number <> 0 Then
                lngErrorCount = lngErrorCount + 1
                Err.Clear
            End If
        End If
    Next
    On Error GoTo 0
    
    '結果表示
    Dim strResult(3) As String
    strResult(0) = "ファイル名に日付を追加しました"
    strResult(1) = "実施回数：" & lngTimesCount
    strResult(2) = "成功数　：" & lngTimesCount - lngErrorCount
    strResult(3) = "エラー数：" & lngErrorCount

    MsgBox Join$(strResult, vbLf), vbInformation
    
End Sub