Skip to content

Instantly share code, notes, and snippets.

@Neos21

Neos21/Module.bas

Last active Mar 24, 2017
Embed
What would you like to do?
ブックを開きたい人が現れたら通知する Excel マクロ
' 通知ファイル名のフルパス (ThisWorkbook の notifyFile と同じ値を保持する)
Dim notifyFilePath As String
' 通知をしたか・通知を出したら True にする
Dim notified As Boolean
' 監視プロシージャの呼び出し
Sub audit(notifyFile As String)
' ThisWorkbook から引数で受け取った通知ファイル名をセットし直す (変数のスコープが異なるため)
notifyFilePath = notifyFile
' 通知をしたか管理する変数の初期化
notified = False
' 監視プロシージャを呼び出す
Call intervalAction
End Sub
' 監視プロシージャ
Sub intervalAction()
' 既に通知済なら中止する
If notified = True Then
Exit Sub
End If
' 通知ファイルを取得する
If Dir(notifyFilePath) <> "" And notified <> True Then
' ファイル名が返却され、通知が未済なら通知を行う
MsgBox "ブックを閉じて欲しい人が現れました!編集が完了したら速やかにブックを閉じてください。"
' 通知済にする
notified = True
Else
' 通知ファイルがないようであれば5秒後に再実行する
Application.OnTime Now + TimeValue("00:00:05"), "intervalAction"
End If
End Sub
' 通知ファイル名のフルパスを保持する
Dim notifyFile As String
' ブックを開いた時に実行する
Sub Workbook_Open()
' 通知ファイル名の生成
notifyFile = ThisWorkbook.FullName & "_.notify"
If ThisWorkbook.ReadOnly = True Then
' 読み取り専用で開いた場合、ファイルを開いている人に通知を投げるか確認する
Dim prompt As Integer
prompt = MsgBox("ファイルを開いている人に通知を送信しますか?", vbYesNo + vbQuestion)
If prompt = vbYes Then
' 通知ファイルを生成する
CreateObject("Scripting.FileSystemObject").CreateTextFile notifyFile
MsgBox "通知を送信しました。"
End If
Else
' 編集モードで開いた場合、通知ファイルがあるか定期的に監視して、通知ファイルができたらアラートを出す
audit notifyFile
End If
End Sub
' ブックを閉じる時に実行する
Sub Workbook_BeforeClose(Cancel As Boolean)
' 編集モードだった人がファイルを閉じる時は、通知ファイルを削除する
If ThisWorkBook.ReadOnly = False Then
On Error Resume Next
Kill notifyFile
On Error GoTo 0
End If
End Sub
@Neos21

This comment has been minimized.

Copy link
Owner Author

@Neos21 Neos21 commented Mar 24, 2017

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment