Ortak alandaki bir Excel dosyasının açık olup olmadığını kontrol etme ..

[pNouma]

Kıymetli Hocalarım merhabalar,

Ortak server altında bulunan ve erişim yetkisi olan herkesin açabileceği bir dosyanın açık olup olmadığını kontrol etmek için aşağıdaki kodu buldum ama bu kod sanırsam eğer dosya kendi bilgisayarımda açıksa doğru çalışıyor.

Benim istediğim dosyanın her hangi biri tarafından da açılmış olsa da bunu öğrenebilmek ....

destek ve yardımlarınız için şimdiden çok teşekkür ederim.

Sub testIsOpen()
    Dim sFN     As String
    Dim bFlag   As Boolean
    myPath = "\\10.x.x.xx\nFolder\DB"
    sFN = myPath & "\FileName.xlsx"  
    bFlag = IsWkbOpen(sFN)
    Debug.Print bFlag
End Sub

Public Function IsWkbOpen(ByVal sFileName As String) As Boolean
    Dim wkb         As Workbook
    Dim bReturn     As Boolean
    On Error GoTo EH   
    bReturn = True
    Set wkb = Workbooks(sFileName)
    IsWkbOpen = bReturn
    Exit Function
EH:
    bReturn = False
    Resume Next
End Function

iyi Çalışmalar dilerim.

 

[RBozkurt]

Dosya her açıldığında ilgili dosyanın içine veya başka bir yere tarih saat vs. pc username şeklinde kayıt da yaptırabilirsiniz.

 

[Korhan Ayhan]

Böyle olabilir mi...

Function IsFileOpen(ByVal FilePath As String) As Boolean
    Dim FileNumber As Integer
    Dim ErrorNumber As Integer
    
    ' Bir dosya numarası al
    FileNumber = FreeFile
    
    On Error Resume Next
    ' Dosyayı sadece okuma modunda açmayı dene
    Open FilePath For Input Lock Read As #FileNumber
    ' Hata numarasını al
    ErrorNumber = Err.Number
    On Error GoTo 0
    
    Select Case ErrorNumber
        Case 0
            ' Hata yoksa dosya açık değil, dosyayı kapat
            Close #FileNumber
            IsFileOpen = False
        Case 70
            ' Hata 70: Dosya başka bir kullanıcı tarafından kilitlenmiş
            IsFileOpen = True
        Case Else
            ' Diğer hataları işleyebilirsiniz
            MsgBox "Beklenmeyen bir hata oluştu: " & ErrorNumber, vbExclamation
            IsFileOpen = False
    End Select
End Function

Sub TestIsFileOpen()
    Dim FilePath As String
    Dim Result As Boolean
    
    ' Kontrol edilecek dosyanın yolunu belirle
    FilePath = "\\AğYolu\DosyaAdı.xlsx"
    
    ' Fonksiyonu çağır ve sonucu kontrol et
    Result = IsFileOpen(FilePath)
    
    If Result Then
        MsgBox "Dosya açık!", vbInformation
    Else
        MsgBox "Dosya kapalı.", vbInformation
    End If
End Sub

 

[pNouma]

Böyle olabilir mi...

Function IsFileOpen(ByVal FilePath As String) As Boolean
    Dim FileNumber As Integer
    Dim ErrorNumber As Integer
   
    ' Bir dosya numarası al
    FileNumber = FreeFile
   
    On Error Resume Next
    ' Dosyayı sadece okuma modunda açmayı dene
    Open FilePath For Input Lock Read As #FileNumber
    ' Hata numarasını al
    ErrorNumber = Err.Number
    On Error GoTo 0
   
    Select Case ErrorNumber
        Case 0
            ' Hata yoksa dosya açık değil, dosyayı kapat
            Close #FileNumber
            IsFileOpen = False
        Case 70
            ' Hata 70: Dosya başka bir kullanıcı tarafından kilitlenmiş
            IsFileOpen = True
        Case Else
            ' Diğer hataları işleyebilirsiniz
            MsgBox "Beklenmeyen bir hata oluştu: " & ErrorNumber, vbExclamation
            IsFileOpen = False
    End Select
End Function

Sub TestIsFileOpen()
    Dim FilePath As String
    Dim Result As Boolean
   
    ' Kontrol edilecek dosyanın yolunu belirle
    FilePath = "\\AğYolu\DosyaAdı.xlsx"
   
    ' Fonksiyonu çağır ve sonucu kontrol et
    Result = IsFileOpen(FilePath)
   
    If Result Then
        MsgBox "Dosya açık!", vbInformation
    Else
        MsgBox "Dosya kapalı.", vbInformation
    End If
End Sub

Çok teşekkür ederim Hocam
iyi çalışmalar.