ファイル名変更

業務で、連続して複数のファイルに対し、ある特定のルールで名称変更
することになった。今から作って、明日早速試してみよう。

名前を変更するには、Nameステートメントが便利だ。
docs.microsoft.com

' 構文
Name A As B

• Ａ：変更前のファイルパス
• Ｂ：変更後のファイルパス

単なるファイル名ではなく、ファイルパスとなっているため、
名称変更に加えてファイル移動も可能となる。

ということで、作成したのがこちら。

Function Rename(source_path As String, _
                new_name As String) As Boolean

    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
        ' 元ファイルの存在確認。
        If FSO.FileExists(source_path) = False Then
            Rename = False
            Exit Function
        End If
            
    Dim ParentPath As String
        ' 指定ファイルの保存フォルダ。
        ParentPath = FSO.GetParentFolderName(source_path)
        
    Dim NewPath As String
        ' 名前変更後のパス作成。
        NewPath = ParentPath & "\" & new_name & "." & FSO.GetExtensionName(source_path)
    
        ' 名前変更。
        ' 禁止文字などがある場合、エラー発生。
        ' これを捉えて、名称変更成否の戻り値とする。
        On Error Resume Next
        Name source_path As NewPath
        Select Case Err.Number
            Case 0
                Rename = True
            Case Else
                Rename = False
        End Select
        
End Function

別に関数にする必要も無いのだが、名称変更の成否を
戻り値とすると、何かと都合が良い場合もある。

では、早速テストしてみよう。

Sub test()
    Dim source_path As String
        source_path = "C:\Temp\古い名前.xlsx"
    Dim new_name As String
        new_name = "新しい名前"
    
        If Rename(source_path, new_name) = False Then
            MsgBox "名称変更に失敗しました。"
        End If
End Sub

どうやら、上手くいったようだ。
これで明日は、予定より10分早く帰れそうです。

参考まで。