共有フォルダのファイルを守る

（Microsoft365 64bit環境推奨）

【ThisWorkbookモジュール】に【Private Sub Workbook_Open】を貼り付ける。
【標準モジュール】に【Public Sub CheckAccess】を貼り付ける。
イミディエイトに ?Environ(“ComputerName”) を記載し、【Enter】キーを押下し、取得した文字をConst MY_PC As String = “pcName” の　”pcName“　の部分に書き込む（””）の間
Const PASSWORD As String = “nazonazo” ←パスワード認証用：任意の文字列に変更する。
コンパイルして保存する。

※　間違えるとファイルが開けなくなる可能性があるので、ファイルのコピーを取ってから、テストしてください。

　モジュール名：M01_Main

Option Explicit
'【ThisWorkbookモジュール】に記載
Private Sub Workbook_Open()
    ' 会社環境で問題がなければ呼び出す
    ' 問題があるならコメントアウトして手動実行にする
    Call CheckAccess
End Sub

'【標準モジュール】に記載
'+++*********************************************************+++
'   共有フォルダ内のファイルアクセスを記録し、
'   自分以外のPCから開いた場合は警告とパスワード認証を行う
'   ログは日付ごとにファイルを分割して保存
'+++*********************************************************+++
Public Sub CheckAccess()
    '=== 設定値（環境に応じて変更可能） ===
    Const MY_PC As String = "pcName"   　　　　 　' 自分のPC名（?Environ("ComputerName")で取得）
    Const PASSWORD As String = "nazonazo"         ' 認証用パスワード:
任意の文字列で設定
    
    '=== 変数宣言 ===
    Dim currentPC As String
    Dim currentUser As String
    Dim logFolder As String
    Dim logFile As String
    Dim logText As String
    Dim pw As String
    
    '=== 環境情報の取得 ===
    currentPC = Environ("ComputerName")   ' PC名を取得
    currentUser = Environ("Username")     ' Windowsログインユーザー名を取得
    
    '=== フォルダを自動取得 ===
    logFolder = ThisWorkbook.Path & "\"   ' このブックが置いてあるフォルダ
    logFile = logFolder & "access_log_" & Format(Date, "yyyymmdd") & ".txt"
    
    '=== ログ記録 ===
    On Error Resume Next
    Open logFile For Append As #1
    If Err.Number = 0 Then
        logText = Format(Now, "yyyy/mm/dd hh:nn:ss") & vbTab & _
                  currentPC & vbTab & _
                  currentUser & vbTab & _
                  ThisWorkbook.Name
        Print #1, logText
        Close #1
    Else
        MsgBox "ログファイルに書き込めませんでした。", vbExclamation
        Err.Clear
    End If
    On Error GoTo 0
    
    '=== PC判定（自分以外のPCから開いた場合） ===
    If currentPC <> MY_PC Then
        ThisWorkbook.Worksheets(1).Select
        
        MsgBox "個人用のファイルです。内容を見るにはパスワードが必要です。", vbExclamation
        pw = InputBox("パスワードを入力してください：")
        
        If pw <> PASSWORD Then
            MsgBox "パスワードが違います。ファイルを閉じます。", vbCritical
            ThisWorkbook.Close SaveChanges:=False
        End If
    End If
End Sub