Salt okunur dosya açılmasın

[ASLAN7410]

Merhaba, hayırlı günler.

Ağ ortakta kullandığımız excel dosyamız mevcut, bu dosya başka kullanıcı tarafından açık olduğu zaman ve
bir başka kullanıcı tarafından açılmaya çalışıldığında salt okunur olarak dosya açılıyor.

Yapmak istediğim excel dosyasını bir kullanıcı açtıysa, başka kullanıcı aynı dosyayı açmaya çalıştığında hiç açılmasın.
Yani ortak kullanılan dosyayı sadece 1 kişi açmış olsun.

Yardımcı olur musunuz?

 

[GursoyC]

Aşağıdaki kodları bir modüle koyarsanız işinizi çözecektir.
Hiç açılmasın şeklinde değil de, açılsın mı açılmasın mı şeklinde soru sorulacak tipte yazdım. İçerisinden veri bakılmasına bile gerek yok derseniz ikinci if yes'li kısmı silebilirsiniz.

Sub auto_open()

    If ThisWorkbook.ReadOnly Then
           
            x = MsgBox("Dosyayı salt okunur olarak açtınız. Bu şekilde kayıt yapamazsınız! Devam etmek istiyor musunuz?", vbYesNo)
            If x = vbYes Then
                sayfa1.activate
                Else
                ThisWorkbook.Close False
                Exit Sub
            End If
    End If
   
   End Sub

 

[ASLAN7410]

Sayın unlimitted ilginiz için çok teşekkür ediyorum.

Ortak ağda kullandığımız dosya içerisine yazmış olduğunuz kodu ekleyerek dosyayı çalıştırdım, if yes kısmınıda sildim ve kodsuz çalıştırdığımda ekte gönderdiğim uyarı hepsinde de aynı geliyor, kod veya kodsuz aynı mesaj ekrana çıkıyor.

 

[Haluk]

Sub Test()
    'Haluk -20/08/2003
    '
    Dim MyFile As String
    MyFile = "\\iishdpe\ortak\Test.xls"
    
    On Error GoTo FileInUse
    Open MyFile For Binary Access Read Lock Read As #1
    Close #1
    MsgBox "Dosya daha önceden kullanımda değil, açabilirsiniz !"
    Workbooks.Open MyFile
    Exit Sub
FileInUse:
    MsgBox "Dosya şu anda başkası tarafından kullanılmakta !"
End Sub

.

 

[ASLAN7410]

Sayın Haluk Bey, ilginiz için çok teşekkür ediyorum.
Yazmış olduğunuz kodu bu başlık altına alıp
Private Sub Workbook_Open()

MyFile = "\\iishdpe\ortak\Test.xls" bu kısmı
MyFile = "\\iishdpe\Ortak\Paylaşım\Aslan\Test.xlsm" bu şekilde yapıyorum. Dasya başkası tarafından açık olmamasına rağmen,
Dosya şu anda başkası tarafından kullanılmakta ! bu şekilde ekrana uyarı mesajı geliyor.
Dosya başkası tarafından açık olduğu zaman, ekte gönderdiğim resimdeki gibi yine uyarı bu şekilde geliyor.

 

[Haluk]

MyFile = "\\iishdpe\Ortak\Paylaşım\Aslan\Test.xlsm"

"Kırmızı" ile belirttiğim kısım, sizin açmaya çalıştığınız dosyanın olduğu bilgisayarın adı olacak, diğer kısmı da dosya yolu......

.

 

[ASLAN7410]

Merhaba Haluk Bey, gece çalıştığım için bilgisayar başına yeni geçtim.

Dediğiniz gibi MyFile = "\\iishdpe\Ortak\Paylaşım\Aslan\Test.xlsm" bu kısmı aşağıdaki gibi yaptım, dosya kimsede açık olmadığı halde ben dosyayı açtığımda, Dosya şu anda başkası tarafından kullanılmakta mesajı vermekte, ben dosyayı kapatıyorum, başkası açıyor ve sonrada ben açtığımda ekte gönderdiğim resimdeki gibi uyarı ekrana geliyor.

MyFile = "\\ANKMRK1\Ortak\Paylaşım\Aslan\Test.xlsm"

 

[ASLAN7410]

Sayın Haluk Bey, Test dosyası bu klasör içerisinde bulunuyor.
Bi türlü istediğim sonucu alamadım.

 

[Haluk]

Kodu söz konusu ortak alandaki dosyaya değil, o dosyayı açmaya çalıştığınız kendi bilgisayarnızdaki dosyada kullanacaksınız.

Bu şekilde mi işlem yapıyorsunuz?

.

 

[ASLAN7410]

Sayın Haluk Bey, dosya "\\ANKMRK1\Ortak\Paylaşım\Aslan\ bu klasör içerisinde Test.xlsm dosyası, ortaktaki bu dosyada çalışma yaptığımız için koduda ortaktaki dosyaya ekliyorum.

 

[Haluk]

Hayır.....

Kendi bilgisayarınızdaki bir Excel dosyasından, ortak alandaki o dosyayı açmaya çalıştığınızı düşünerek vermiştim ben o kodu.

.

 

[ASLAN7410]

Anladım Haluk Bey, benim istediğim bi şey yapılır mı?

 

[Haluk]

Aşağıdaki kodları, sizin ortak alandaki dosyanın ThisWorkbook (BuKitap) modülüne ekleyin, dosyayı kaydedip, kapatın.

Daha sonra denemelerinizi yapın.... Bakalım, ne olacak ?

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
        If Not ActiveWorkbook.ReadOnly = True Then
            Kill ThisWorkbook.Path & "\user.txt"
        End If
    On Error GoTo 0
End Sub

Private Sub Workbook_Open()
    Dim FileNo As Integer
    Dim strLine As String
    FileNo = FreeFile
   
    If Not ActiveWorkbook.ReadOnly = True Then
        Open ThisWorkbook.Path & "\user.txt" For Append As #FreeFile
        Print #FileNo, Environ("USERNAME") & " @ " & Now()
        Close #FileNo
    Else
        Open ThisWorkbook.Path & "\user.txt" For Input Access Read As #FileNo
            Do While Not EOF(FileNo)
               Line Input #FileNo, strLine
            Loop
        Close #FileNo
        MsgBox "Dosya kullanımda: " & strLine
        If ActiveWorkbook.ReadOnly = True Then ActiveWorkbook.Close SaveChanges:=False
    End If
End Sub

.

 

[ASLAN7410]

Sayın Haluk Bey, ellerinize sağlık kodlar gayet güzel çalışıyor.
Ortaktaki dosyayı açmak istediğimde ekte gönderdiğim 1.resimdeki uyarı mesajı geliyor, salt okunuru işaretlediğimde dosya açılıyor ve 2. resimdeki mesaj geliyor tamam deyince kapanıyor.

Sayın Haluk Bey, ben 1.mesajın gelmesini istemiyordum, 1.mesaj uyarısı herhalde excelin kendi içerisinde bulunan birşey galiba.

 

[Haluk]

Evet, 1. mesaj Excel'in kendi mesajı.... 2. mesaj ise, kodların verdiği bir mesaj. Dosya eğer daha önce başkası tarafından açılmışsa, açan kişinin kullanıcı adını ve dosyanın ne zaman açıldığını belirtiyor.....

.

 

[ASLAN7410]

Sayın Haluk Bey, bu şekilde de güzel oldu, ellerinize sağlık çok teşekkür ediyorum.

Hayırlı geceler diliyorum.

 

[emsey]

Sayın Haluk Bey, ilginiz için çok teşekkür ediyorum.
Yazmış olduğunuz kodu bu başlık altına alıp
Private Sub Workbook_Open()

MyFile = "\\iishdpe\ortak\Test.xls" bu kısmı
MyFile = "\\iishdpe\Ortak\Paylaşım\Aslan\Test.xlsm" bu şekilde yapıyorum. Dasya başkası tarafından açık olmamasına rağmen,
Dosya şu anda başkası tarafından kullanılmakta ! bu şekilde ekrana uyarı mesajı geliyor.
Dosya başkası tarafından açık olduğu zaman, ekte gönderdiğim resimdeki gibi yine uyarı bu şekilde geliyor.

Üstad bu kodlar çok işime yaradı öncelikle emeğine sağlık ben kodları kendime uyarladım tüm kodların en başına ekledim dosya kullanımdaysa exitsub yaptım değilse tüm kodlara devam ettim ancak burada dosyanın kimin tarafından kullanıldığını çözemedim. Yardımcı olur musun?

'''''' yeşillik dosyasının kullanımda olup olmadığını kontrol ediyoruz.
Dim yesillik As String
Dim sayfaadi As String
sayfaadi = Format(ActiveSheet.Range("A1"), "dd.mm.yy")
yesillik = kaynak.Range("C5").Value & "\" & kaynak.Range("B5").Value & ""
On Error Resume Next
Open yesillik For Binary Access Read Lock Read As #1
If Err.Number <> 0 Then
MsgBox "Dosya şu anda başkası tarafından kullanılmakta !", vbInformation, "Dosya Kullanımda!"

Exit Sub
End If
Close #1
On Error GoTo 0

 

[hafasepa]

Sub Test()
    'Haluk -20/08/2003
    '
    Dim MyFile As String
    MyFile = "\\iishdpe\ortak\Test.xls"
   
    On Error GoTo FileInUse
    Open MyFile For Binary Access Read Lock Read As #1
    Close #1
    MsgBox "Dosya daha önceden kullanımda değil, açabilirsiniz !"
    Workbooks.Open MyFile
    Exit Sub
FileInUse:
    MsgBox "Dosya şu anda başkası tarafından kullanılmakta !"
End Sub

.

Allah razı olsun