[[20180606181547]]　『Excelファイルの自動クローズ処理』（まお）　ページの最後に飛ぶ

『Excelファイルの自動クローズ処理』（まお）

共有のExcelファイルをしており誰かが開いて離席しているせいで入力ができないことがあります。
対策としてそのファイルを開き一定時間操作がされなかった場合には自動で
ファイルを閉じてしまいたいのですが方法がわかりません。
どなたか力を貸していただけないでしょうか？
よろしくお願いします。

＜使用 Excel：Excel2013、使用 OS：Windows10 ＞

https://allabout.co.jp/gm/gc/297707/

↑この設定をしたらいかがでしょう？

（まっつわん） 2018/06/06(水) 19:44

ブックを開くと、ファイル名の先頭に「~$」が付いたテンポラリファイルが作成されるのですが、ブックを開いたままではこれを削除する事ができません。なので、ブックを「読み取り専用を推奨する」チェックを付けて保存しておくのが良いです。（見るだけの人が読み取り専用で開くようになるので、更新者が排他されなくなります）

別案として、テンポラリファイルから作成者を表示するマクロを書いてみました。更新日時が古いものが表示された場合、それは開きっぱなしで回線切断した跡なので、消しても構わないでしょう。当日のものがあれば、利用者が判れば、直接ブックを閉じるように依頼すれば良いですよね。

ちなみに、テンポラリファイルにはシステム属性が付いているので、マクロからは自動削除できないので、手作業で削除する必要があります。開いた当人なら、ブックを閉じるだけですが。

 Sub test()
    Const cPATH = "C:\tmp\"
    Dim F1 As Integer
    Dim cFiles As Variant
    Dim cw As String
    Dim i As Long
    Dim j As Long
    Dim iw As Long
    Dim iR As Long
    Dim iEr As Long
    Dim iLen As Long
    Dim bw() As Byte
    Dim bName() As Byte

    Application.ScreenUpdating = False
    Cells.ClearContents
    Range("A1:D1") = Array("フルパス", "ファイル名", "更新日時", "利用者")
    iR = 2

    cFiles = Split(CreateObject("WScript.Shell").Exec("CMD /C DIR /A/B/S """ & cPATH & "~$*.*""").StdOut().ReadAll(), vbNewLine)

    For i = 0 To UBound(cFiles) - 1
        iEr = 0
        On Error Resume Next
        iLen = FileLen(cFiles(i))
        iEr = Err.Number
        On Error GoTo 0
        If iEr = 0 And 0 < iLen Then
            ReDim bw(iLen - 1)
            F1 = FreeFile
            iEr = 0
            On Error Resume Next
            Open cFiles(i) For Binary As #F1
            iEr = Err.Number
            If iEr = 0 Then
                Get #F1, , bw
                iEr = Err.Number
            End If
            Close #F1
            On Error GoTo 0

            If iEr = 0 Then
                cw = ""
                ReDim bName(bw(0) - 1)
                For j = 1 To bw(0)
                    bName(j - 1) = bw(j)
                Next j
                Cells(iR, "A").Value = cFiles(i)
                Cells(iR, "B").Value = Mid(cFiles(i), InStrRev(cFiles(i), "\") + 3)
                Cells(iR, "C").Value = FileDateTime(cFiles(i))
                Cells(iR, "D").Value = StrConv(bName, vbUnicode)
                iR = iR + 1
            End If
        Else
            Cells(iR, "A").Value = cFiles(i)
            Cells(iR, "B").Value = Mid(cFiles(i), InStrRev(cFiles(i), "\") + 3)
            On Error Resume Next
            Cells(iR, "C").Value = FileDateTime(cFiles(i))
            On Error GoTo 0
            iR = iR + 1
        End If
    Next i

    Columns("A:A").ColumnWidth = 2
    Columns("B:D").AutoFit
    Application.ScreenUpdating = True
 End Sub
（???） 2018/06/07(木) 09:34

コメント返信：

[ 一覧(最新更新順) ]

[[20180606181547]] 『Excelファイルの自動クローズ処理』（まお） ページの最後に飛ぶ

[[20180606181547]]　『Excelファイルの自動クローズ処理』（まお）　ページの最後に飛ぶ