共有サーバーのEXCELファイルを開いたまま帰った人がいて困ったことがあったので作ってみた。
EXCELの標準モジュールにそのまま張り付ければ使えると思う。
Option Explicit '***************************************************************************** ' EXCELファイルを誰が開いているか記録するマクロ ' ' 【機能】EXCELファイルと同じフォルダにファイル名の拡張子を「.log」にしたファイル ' にEXCELファイルを開いた時と閉じた時の日時、IPアドレス、PC名、読込専用かを ' 記録する ' ' 日付 Ver 氏名 コメント ' 2017/05/23 1.00 新規リリース ' '***************************************************************************** Sub Auto_Open() Dim f As Integer f = FreeFile Open ActiveWorkbook.Path & "\" & getLogFilename For Append As #f Print #1, Date & "," & Time & ",[OPEN" & checkReadOnly & "]," & GetIPAddress & "," & Environ("COMPUTERNAME") Close #f End Sub Function checkReadOnly() As String Dim mode As String If ThisWorkbook.ReadOnly = True Then mode = "(読み取り専用)" Else mode = "" End If checkReadOnly = mode End Function Sub auto_Close() Dim f As Integer f = FreeFile Open ActiveWorkbook.Path & "\" & getLogFilename For Append As #f Print #1, Date & "," & Time & ",[CLOSE" & checkReadOnly & "]," & GetIPAddress & "," & Environ("COMPUTERNAME") Close #f End Sub Function getLogFilename() As String Dim FSO As Object Set FSO = CreateObject("Scripting.FileSystemObject") getLogFilename = FSO.GetBaseName(ThisWorkbook.Name) & ".log" Set FSO = Nothing End Function '***************************************************************************** ' IP アドレス取得 ' WMI を用いて IP アドレスを取得する。 '***************************************************************************** Function GetIPAddress() As String Dim NetAdapters, objNic, strIPAddress Set NetAdapters = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") _ .ExecQuery("Select * from Win32_NetworkAdapterConfiguration " & _ "Where (IPEnabled = TRUE)") For Each objNic In NetAdapters 'ネットワークアダプターは、複数ある場合がある For Each strIPAddress In objNic.IPAddress 'IPは、複数割り当てられている場合がある GetIPAddress = strIPAddress Exit For ' 1回のみ Next Exit For ' 1回のみ Next End Function