ボタンを押すとファイルをバックアップするプログラム。
<プログラム>
Private Sub BackUp_Click()
On Error Resume Next
ThisWorkbook.Save
If Err.Number <= 0 Then
'デスクトップにバックアップフォルダを作成した場合
Dim backupPath As String
backupPath = "C:\Users\" & Application.UserName & "\Desktop\" & Format(Date,"YYYY") & "_bk"
'古いバックアップを消す
Call trushClear(backupPath)
'ファイル移動オブジェクト(複数用)
Dim objFSO As Object, txtSource As String, txtDestination
Set objFSO = CreateObject("Scripting.FileSystemObject")
'バックアップのコピー
Call copyNewBk(objFSO)
End If
End Sub
Private Sub trushClear(backupPath As String)
'バックアップフォルダの存在チェック
If Dir(backupPath, vbDirectory) = "" Then
MkDir backupPath
End If
'※ファイル名は任意
If Dir(backupPath & "\" & Format(Date, "yyyymmdd") & "残したいファイル_*.xlsm") <> "" Then
Kill backupPath & "\" & Format(Date, "yyyymmdd") & "残したいファイル_*.xlsm"
End If
End Sub
Private Sub copyNewBk(backupPath As String, objFSO As Object)
'残したいファイル ※objFSO.CopyFileは、開いていてもコピーできる(最後に保存されたタイミングのコピーとなる)
objFSO.CopyFile ThisWorkbook.FullName, backupPath & "\残したいファイル_" & Format(Date, "yyyymmdd") & ".xlsm"
' '参考 ※FileCopyは、開いているファイルはコピーできない
' FileCopy "バックアップを取りたいファイルが置かれているフォルダ/" & "\残したいファイル_" & Format(Date, "yyyymmdd") & ".xlsm", backupPath & "\残したいファイル_" & Format(Date, "yyyymmdd") & ".xlsm"
End Sub
<オマケ>
ファイルをカウントする。
Private Function countFile(filePath As String, fileName As String) As Long
Dim cnt As Long
Dim tmp As String
cnt = 1
tmp = Dir(filePath & "\" & fileName)
Do While tmp <> ""
cnt = cnt + 1
tmp = Dir()
Loop
countFile = cnt
End Function