趣味プログラミングblog

---

着想

ベースとなるソースは、Word、Excelで使ってるバックアップをとって上書き保存するマクロ。特にファイル名のメモからバージョン履歴を作るのがめっちゃ便利。
スクリプトで書けばどのファイルでも似たことができるじゃんという発想。

マクロについてはこちら。

作業手順

このソースコードをCopilotに読み込ませてVBScriptで作成させてみた。バックアップフォルダは、入力ファイルと同じパスになるよう手直し。

操作性を考慮して、送るメニューから起動することを想定して入力ファイルは1つに限定。

最後にshell:sendtoフォルダにショートカットを配置して完成。

使い方

バックアップ取る際には、ファイルを保存する前に対象ファイルで右クリック(またはShift +F10) + N, Mで表示されたウィンドウにメモを入力。
上書き保存したあとに更新内容について再度入力するような使い方。

なお、windows11だと、右クリックからその他操作を選択しないと送るメニューが表示されなくなっているので注意。

この問題については別の記事を書く予定。
ということで、以下ソース。

---

mメモをバックアップ.vbs

Option Explicit

 

'ドラッグドロップ
Dim objArgs : Set objArgs = WScript.Arguments   '入力
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim strFolder, strFile, strPath, strExt
Dim cnt, stText

 

If objArgs.Count <> 1 Then
    call errorEnd("入力は１ファイルのみです")
Else
    strPath = objArgs(0)
    If objFSO.FolderExists(strPath) Then
    call errorEnd("入力は１ファイルのみです")
    ElseIf objFSO.FileExists(strPath) Then
        call add_text2filename(strPath)
    End If
End If

 

'ファイルに対するメイン処理

 

Sub add_text2filename(file)
  Dim objFSO, objShell, BKUPpath, fileName, fileExt, pos, backupName, note
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objShell = CreateObject("Shell.Application")  
  
  ' BKUPフォルダのパスを設定
  BKUPpath = objFSO.GetParentFolderName(file) & "\BKUP"
  
  ' BKUPフォルダが存在しない場合は作成
  If Not objFSO.FolderExists(BKUPpath) Then
      objFSO.CreateFolder(BKUPpath)
  End If
  
  ' ファイル名と拡張子を分割
  fileName = objFSO.GetBaseName(file)
  fileExt = objFSO.GetExtensionName(file)
  
  ' メモを入力
  note = InputBox("ファイル名に記載する更新内容を入力してください。", "更新内容は？")
  
  ' バックアップファイル名を作成
  dim date
  date=Replace(now, "/", "") 
  date=Replace( date , ":" , "" )
  date=Replace( date , " " , "_" )
  date=left(date , 13)
  If note = "" Then
      backupName = BKUPpath & "\" & fileName & "_" & date & "_UPDT." & fileExt
  Else
      backupName = BKUPpath & "\" & fileName & "_" & date & "_UPDT(" & note & ")." & fileExt
  End If
  msgbox backupName
  ' ファイルをコピー
  objFSO.CopyFile file, backupName
  
  ' オブジェクトを解放
  Set objFSO = Nothing
  Set objShell = Nothing

 

End Sub