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

ファイル名に日付を追加

多数のファイルの名前にまとめて日付を追加するマクロです。

マクロ「Select_Files」を実行すると、ファイル参照ダイアログが表示されます。
ファイルを選択すると、選択したファイル全てのファイル名に、日付が追加されます。
デフォルトでは西暦4桁+月2桁+日2桁ですが、定数の設定で西暦を2桁に変更できます。



サンプルコード

コードの貼り付け場所

'+++ 宣言セクション +++
Private Const CONF As Boolean = False 'False:西暦4桁 True:西暦2桁(10の位まで)

Sub Select_Files() Dim varFileName As Variant Dim strFilePath As String 'ファイルを選択 varFileName = Application.GetOpenFilename("全てのファイル,*.*", , , , True) If VarType(varFileName) = vbBoolean Then Exit Sub '日付追加 Dim v As Variant Dim c As Long Dim s As String Dim strDate As String strDate = Get_Date(CONF) '日付取得 For Each v In varFileName c = InStrRev(v, ".") If 0 < c Then s = Left$(v, c - 1) & strDate & Mid$(v, c) Call Change_FN(v, s) End If Next End Sub
Private Function Get_Date(Optional f As Boolean = False) As String Dim datToday As Date Dim strFileName(3) As String datToday = Date strFileName(0) = "_" '西暦の取得 フラグがTrueの場合 西暦は10の位まで strFileName(1) = IIf(f, Right$(CStr(Year(datToday)), 2), CStr(Year(datToday))) strFileName(2) = Format$(datToday, "mm") '月を2桁に変換 strFileName(3) = Format$(datToday, "dd") '日を2桁に変換 Get_Date = Join$(strFileName, vbNullString) End Function
Private Sub Change_FN(ByVal OldPName As String, ByVal NewPName As String) On Error Resume Next Name OldPName As NewPName On Error GoTo 0 End Sub

【定数】CONF
 False:西暦4桁 True:西暦2桁


サンプルファイル

今回のコードを載せたファイルを準備しました。よければご使用ください。
●サンプルファイル ダウンロード



ページトップへ戻る

Excel 汎用コード



Word 汎用コード

Copyright(C) 2009- 坂江 保 All Rights Reserved.