ray88’s diary

お仕事で困ったとき用の自分用の覚書

Excel VBA 指定したフォルダにバックアップファイルを取る 部品

■元ファイルのBackUpを取っておく

Function BackUpFile(ByVal backupPath As String, ByVal originalFilePath As String) As String
'----------------------------------------------------------------------------
'機能:指定したフォルダパスに元ファイルをコピーし、の元のファイル名の頭に
'     「BackUp_」をつけたファイル名で格納する

'引数1   :BackUp格納先のフォルダパス
'         (元ファイルと同じパスに格納する場合は「same」を指定する)
'引数2   :元ファイルのパス
'戻り値  :BackUpファイルのパス
'----------------------------------------------------------------------------
    'フォルダが存在しない場合は、作成する
    If backupPath <> "same" And Dir(backupPath, vbDirectory) = "" Then
        MkDir backupPath
    End If
    
    'バックアップファイルのファイル名を作成する
    Dim backupFileName As String
    backupFileName = "BackUp_" & Dir(originalFilePath)
    
    'バックアップファイルのパスを作成する
    Dim backUpFilePath As String
    If backupPath = "same" Then
        backUpFilePath = Left(originalFilePath, InStrRev(originalFilePath, "\")) & backupFileName
    Else
        backUpFilePath = backupPath & "\" & backupFileName
    End If
    
    '元ファイルをバックアップする
    FileCopy originalFilePath, backUpFilePath
    
    'バックアップファイルのパスを返す
    BackUpFile = backUpFilePath
End Function