エクセルのマクロで使用期限

Question

エクセルのマクロでエクセルブック自体に使用期限を設けることは可能ですか？
例えば今使っている２０１７年という名前のブックを２０１８年１月１日にはパスワードがないと開けないようにしたいです。

WindFaller · Accepted Answer

アイデアはいくつか持っています。

2018/1/1 ピッタリと行くかは別ですが、以下の場合は、2017年の12/29が最後の日とみなされて、開いて、閉めれば、パスワードを掛けられてしまう、という方法です。

正月すぎまでファイルを開かなければ、場合によっては、1月1日以降にパスワードが掛けられてしまうかもしれません。
1月1日に自動的に切り替えるには、外部プログラムとタイマーの登録が必要です。

'//ThisWorkbook モジュール
Option Explicit
Const mPSW As String ="abc"  'パスワード
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Const XLMacro As Long = 52
Application.DisplayAlerts = False
''12月29日7時55分以降は、プロテクトを掛けて保存します。
If Now > DateSerial(2017, 12, 29) + TimeSerial(0, 7, 55) Then
　ThisWorkbook.SaveAs ThisWorkbook.Name, XLMacro, mPSW, mPSW
End If
Application.DisplayAlerts = True
End Sub

//

スタンドアロンで、もっと凝った作りをさせることも可能ですが、要求に応じたものを作って差し上げるというわけにはいかないことはご承知ください。あくまでも、ヒントを与えているだけだと思ってください。

なお、OneDrive for Business(Office 365 Premium) に、期限付きファイルというものがあります。
もうひとつは、Microsoft では、ARM(Azure Right Management)　
https://products.office.com/ja-jp/business/microsoft-azure-rights-management
という方法もあります。

WindFaller · Answer

少し、本格的なものを作ってみました。
ご質問者さんがコメントを残していませんし、それを書いても、たぶん、評価は受けないとは思います。VBSですが、暗号化が可能です。Batchとは違うものです。Batchは、1回キリです。

もうこれは、マクロではなく、日時が来たら実行に移すマクロ・ウィルスと同等です。
MsgBox の所がコメントブロックになっているのは、実際は人知れず行うことになるからです。

この有効期限は、標準は3日ですから、仕事始めが、1月4日として6日までに実行されます。コントロールパネルの「タスクのスケジュール」に設定されていますから、用が済んだら、削除したほうがよいでしょう。拡張子は、xls, xlsx, xlsm の3つになっています。それ以外のものは、何もしないようになっています。(MsgBox でコメントを出しません)
必要なら、コードの中のシングルコーテーションを外してください。
'MsgBox "unknow Extention " & Ext

なるべくわかっている人にお使い願いたいです。
#1で書いたARMが標準的です。

'-----------------------
'//XlLock.Vbs
Dim objFS
Dim objFile
Const PSW ="xxx"
Const mPATH ="C:\Temp"
Const oFNAME ="Test1m.xlsm"
Const fDFLT =51
Const fNML =-4143
Const fMCR= 52
Dim BaseName
Dim Ext, xt
Dim flg
'On Error Resume Next
Set objFS = CreateObject("Scripting.Filesystemobject")
If objFS.FileExists(mPATH &oFNAME)=False Then
  ' MsgBox "Not found " & oname & vbCrLf & "Please Check again!"
   WScript.Quit
End If
BaseName= objFS.GetBaseName(mPATH & oFNAME)
Ext = objFS.GetExtensionName(mPATH & oFNAME)
If LCase(Ext) = "xls" Then
  xt =fNML
ElseIf LCase(Ext) = "xlsx" Then
  xt = fDFLT
ElseIf LCase(Ext) = "xlsm" Then
  xt = fMCR
Else
  'MsgBox "unknow Extention " & Ext
  Wscript.Quit
End If   
Dim xlApp
Dim wb
Set xlApp =CreateObject("Excel.Application")
''xlApp.visible =True
 On Error Resume Next
 Set wb=xlApp.Workbooks.Open(mPATH & oFNAME,0,0,,"","")
 On Error Goto 0
 If IsObject(wb) Then  
  wb.Protect PSW 
  WScript.Sleep 1000
 xlApp.DisplayAlerts= False  
 wb.SaveAs mPATH & oFNAME,xt,PSW,PSW
 xlApp.DisplayAlerts= True
 wb.Close False
   Call ErrEndProc(False)
 Else
   Call ErrEndProc(True)
End If
Set xlApp = Nothing
WScript.Quit
Function ErrEndProc(flg)
Set wb = Nothing
xlApp.Quit
Set xlApp = Nothing
 If flg Then
  'WScript.Echo "実行は失敗しました  " & Err.Description
Else
  'WScript.Echo "成功しました。"
End If
WScript.Quit
End Function
'--------------------------切り取り線-------

rem xlLock.vbs と一緒にしておいておくとよい。
rem 場所は適当に書き換えてください。
rem'----xlLock.bat---------------------
@echo off

schtasks /create /tn ChngeLock /sd 2018/01/04 /st 00:00:05 /tr "C:\Users\[YourID]\Documents\xlLock.vbs" /sc once

echo on

ママチャリ · Answer

Workbook_Openイベントプロシジャに仕込んでみました。
このマクロは、翌年以降かつPW未設定の場合にPWを設定して保存します。その後、再オープンすることにより、PWの入力が要求されるようになります。
Workbook_Openイベントプロシジャで自分自身を再オープンすることができるのか疑問だったのですが、とりあえず動作したので良しとしました。

Private Sub Workbook_Open()
    Dim yyyy As Integer
    With ThisWorkbook
        yyyy = Split(.Name, "年", 2)(0)
        If yyyy < Year(Now) And .HasPassword = False Then
            .Password = "abc"
            .Save
            Workbooks.Open .FullName
        End If
    End With
End Sub

【注意点】とりあえず、ブック名から年を特定していますが、例えば「201ｘ年」みたいな想定外の名前だと異常終了します。この辺はご自分でご検討ください。

エクセルのマクロで使用期限

アイデアはいくつか持っています。

少し、本格的なものを作ってみました。

Workbook_Openイベントプロシジャに仕込んでみました。

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング