Excel VBA 逆引き集 | ファイル名を日付付きに

Excel VBA
スポンサーリンク

ねらい：ファイル名に「日付」を自動付与して整理と追跡を楽にする

業務で「毎日出力」「世代管理」「監査」をするなら、ファイル名に日付や時刻を入れるのが最短ルールです。初心者でも迷わないように、保存・コピー・リネームの各テンプレを用意し、重要ポイントを深掘りします。

  • 目的: 世代を一発判別、上書き事故回避、後から探しやすくする
  • 基本戦略: Format(Now, "yyyy-mm-dd") を使って安全な文字列を作り、ベース名＋区切り＋日付＋拡張子の組み立てを標準化
  • 重要ポイント（深掘り）:
    • 無効文字を使わない: \ / : * ? " < > | は禁止。Formatは安全な記号（ハイフン/アンダースコア）にする
    • タイムスタンプで一意化: 同日複数ファイルは「時分秒」を付けて重複回避
    • 保存先を先に用意: フォルダ存在チェック→なければ作成で失敗を防ぐ

日付文字列の作り方（安全・見やすい）

' 例：年月日だけ
Dim stamp As String
stamp = Format(Now, "yyyy-mm-dd")        ' 2025-12-15

' 例：日付＋時刻（重複回避）
Dim stamp2 As String
stamp2 = Format(Now, "yyyy-mm-dd_HHNNSS") ' 2025-12-15_185745
VB
  • 重要ポイント（深掘り）:
    • HHNNSS の意味: 24時制の時・分・秒（VBAは分が N、秒が S）
    • 区切りは「_」か「-」がおすすめ: OSやツールで安定して扱える

テンプレ1：現在のブックを「日付付きファイル名」で保存

Sub SaveWithDate()
    Dim baseName As String: baseName = "月次レポート"
    Dim stamp As String: stamp = Format(Now, "yyyy-mm-dd")
    Dim folder As String: folder = "C:\Reports\"
    Dim path As String: path = folder & baseName & "_" & stamp & ".xlsx"
    
    EnsureFolder folder
    ThisWorkbook.SaveCopyAs path
    MsgBox "保存しました: " & path
End Sub

Private Sub EnsureFolder(ByVal folderPath As String)
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(folderPath) Then fso.CreateFolder folderPath
End Sub
VB
  • 重要ポイント（深掘り）:
    • SaveCopyAs を使う: 元ブックは開いたまま、同内容の「コピー」を日付付きで残せる
    • フォルダの保証: 事前に作ってから保存すると失敗しない

テンプレ2：新規エクスポート（別名で保存）

Sub ExportAsDateName()
    Dim baseName As String: baseName = "売上集計"
    Dim stamp As String: stamp = Format(Now, "yyyy-mm-dd_HHNNSS")
    Dim folder As String: folder = "D:\Export\"
    Dim path As String: path = folder & baseName & "_" & stamp & ".xlsx"
    
    EnsureFolder folder
    ActiveWorkbook.SaveAs Filename:=path, FileFormat:=xlOpenXMLWorkbook ' .xlsx
    MsgBox "エクスポート完了: " & path
End Sub
VB
  • 重要ポイント（深掘り）:
    • SaveAs は「そのファイルが開き直される」動作: 作業続行の前提を理解して使う
    • 拡張子と FileFormat を一致: .xlsxなら xlOpenXMLWorkbook、マクロ付きなら .xlsm＋xlOpenXMLWorkbookMacroEnabled

テンプレ3：CSVなど「シートの範囲」を日付付きで保存

Sub ExportRangeAsCsvWithDate()
    Dim ws As Worksheet: Set ws = Worksheets("Output")
    Dim rng As Range: Set rng = ws.Range("A1").CurrentRegion
    
    Dim baseName As String: baseName = "出力データ"
    Dim stamp As String: stamp = Format(Now, "yyyy-mm-dd")
    Dim folder As String: folder = "C:\Export\"
    Dim path As String: path = folder & baseName & "_" & stamp & ".csv"
    
    EnsureFolder folder
    SaveRangeCsv rng, path
    MsgBox "CSV保存: " & path
End Sub

Private Sub SaveRangeCsv(ByVal rng As Range, ByVal path As String)
    Dim st As Object: Set st = CreateObject("ADODB.Stream")
    st.Type = 2: st.Charset = "UTF-8": st.Open
    Dim r As Long, c As Long, rows As Long, cols As Long
    rows = rng.Rows.Count: cols = rng.Columns.Count
    For r = 1 To rows
        Dim line As String: line = ""
        For c = 1 To cols
            Dim s As String: s = CStr(rng.Cells(r, c).Value)
            s = Replace(s, """", """""")
            line = line & IIf(c > 1, ",", "") & """" & s & """"
        Next
        st.WriteText line & vbCrLf
    Next
    st.SaveToFile path, 2 ' 2=adSaveCreateOverWrite
    st.Close
End Sub
VB
  • 重要ポイント（深掘り）:
    • エンコードは UTF-8 を明示: 日本語の文字化けを防ぐ
    • 範囲は CurrentRegion: ヘッダーから連続データ一式を簡単取得

テンプレ4：既存ファイルを「日付付き」にリネーム（世代履歴化）

Sub RenameWithDateIfExists()
    Dim folder As String: folder = "C:\Reports\"
    Dim baseName As String: baseName = "月次レポート.xlsx"
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim path As String: path = folder & baseName
    If fso.FileExists(path) Then
        Dim stamp As String: stamp = Format(Now, "yyyymmdd_HHNNSS")
        Dim newName As String
        newName = fso.GetBaseName(baseName) & "_" & stamp & "." & fso.GetExtensionName(baseName)
        fso.MoveFile path, folder & newName
        MsgBox "既存を退避リネーム: " & newName
    End If
End Sub
VB
  • 重要ポイント（深掘り）:
    • 退避してから新規保存が安全策。上書き事故を確実に避ける
    • GetBaseName/GetExtensionName: 元の拡張子を維持して命名

テンプレ5：ユーザー入力を安全なファイル名に正規化

Function SafeFileName(ByVal raw As String) As String
    Dim name As String: name = Trim$(raw)
    ' 禁止文字をアンダースコアへ
    Dim badChars As Variant: badChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
    Dim i As Long
    For i = LBound(badChars) To UBound(badChars)
        name = Replace(name, CStr(badChars(i)), "_")
    Next
    ' 先頭末尾のドットは避ける
    Do While Left$(name, 1) = ".": name = Mid$(name, 2): Loop
    Do While Right$(name, 1) = ".": name = Left$(name, Len(name) - 1): Loop
    If Len(name) = 0 Then name = "untitled"
    SafeFileName = name
End Function

Sub SaveWithUserTitleAndDate()
    Dim title As String: title = InputBox("ファイルのベース名を入力")
    Dim baseName As String: baseName = SafeFileName(title)
    Dim stamp As String: stamp = Format(Now, "yyyy-mm-dd")
    Dim path As String: path = "C:\Docs\" & baseName & "_" & stamp & ".xlsx"
    
    EnsureFolder "C:\Docs\"
    ThisWorkbook.SaveCopyAs path
    MsgBox "保存: " & path
End Sub
VB
  • 重要ポイント（深掘り）:
    • 禁則文字の置換は必須: OSエラーの予防線
    • 空やピリオド始まりは避ける: 予期せぬ挙動を防ぐ

例題で練習（貼って試せる）

  • 例1（基本保存）: SaveWithDate → 指定フォルダに「月次レポート_yyyy-mm-dd.xlsx」
  • 例2（重複回避）: ExportAsDateName → 「yyyy-mm-dd_HHNNSS」でユニーク保存
  • 例3（CSVエクスポート）: ExportRangeAsCsvWithDate → CurrentRegionをUTF-8 CSVへ
  • 例4（既存退避）: RenameWithDateIfExists → 既存を日付付きに移動してから新規保存
  • 例5（ユーザー入力）: SafeFileName＋Save → 禁則文字を除去して安全な命名

実務の落とし穴と対策（ここが肝）

  • 落とし穴1：保存先フォルダが存在しない
    • 対策: EnsureFolder で必ず作成してから保存
  • 落とし穴2：同名上書き事故
    • 対策: 時刻入りスタンプで一意化、既存は先に退避リネーム
  • 落とし穴3：禁則文字で保存失敗
    • 対策: SafeFileName で置換、先頭/末尾のピリオドも除去
  • 落とし穴4：拡張子と FileFormat 不一致
    • 対策: .xlsxなら xlOpenXMLWorkbook、.xlsmなら xlOpenXMLWorkbookMacroEnabled をセット
  • 落とし穴5：タイムゾーンによる日付ズレ
    • 対策: 実行PCの時刻を基準にする前提。必要なら業務時刻（例：9:00締め）で日付計算をカスタム

スターター手順（最短導入）

  • 手順1: 「ベース名＋_＋Format(Now)＋拡張子」の命名規則を決める
  • 手順2: SaveCopyAs／SaveAs を選択（コピー保存か実体保存か）
  • 手順3: EnsureFolder／SafeFileName を共通ヘルパーにして再利用
  • 手順4: 重複回避のため yyyy-mm-dd_HHNNSS スタンプを標準に

スポンサーリンク
タイトルとURLをコピーしました