Forhindre save hvis antal filer i mappe overskyder 1

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    If FileCountA("C:/temp/") = 1 Then
    MsgBox ("file is saved")
    Else
    MsgBox ("File is currently being saved by other user, try again later")
    Cancel = True
    If SaveAsUI Then SaveAsUI = False
    End If
       

End Sub


Function FileCountA(Path As String) As Long
    Dim strTemp As String
    Dim lngCount As Long
   
    strTemp = Dir(Path & "*.*")
    Do While strTemp <> ""
        lngCount = lngCount + 1
        strTemp = Dir
    Loop
   
    FileCountA = lngCount
   
End Function