共有サーバーのEXCELファイルを開いた時と閉じた時にPC名とIPアドレスを保存するVBAマクロ

共有サーバーの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        ' １回のみ
        Next
        Exit For        ' １回のみ
    Next

End Function