Excel dosyasının başka bilgisayarda açılmasını engellemek

Katılım
8 Ağustos 2015
Mesajlar
12
Excel Vers. ve Dili
Microsoft Excel 2010 - Türkçe
Altın Üyelik Bitiş Tarihi
07.08.2020
Merhaba
Hazırladığım excel dosyasının açılmasını istediğim bilgisayarlardan başka bilgisayarda açılmasını nasıl engelleyebilirim. Yani excel'in herhangi bir sayfasında yada kodlarda açılmasını istediğim bilgisayarların ID numarasını excel dosyasına tanımlayıp, dosya açılırken o bilgisayarın ID'nin bu listede olup olmadığının kontrol edilmesini ve bilgisayarın ID'si bu listede yoksa açılmamasını istiyorum. Excel ile çok iyi derecede çalışıyorum ancak VBA kodlama bilgim olmadığı için üstadların lütfen yardımcı olmasını rica ediyorum. Çok minnettar olurum.
 

askm

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
HDD seri no öğrenme olarak araştırıp bu numara ile işlem yapabilirsiniz. Aşağıdaki kodlar işinize yarayabilir.
Kod:
 Function HdNum() As String

    Dim fsObj   As Object

    Dim drv     As Object

    Set fsObj = CreateObject("Scripting.FileSystemObject")

    Set drv = fsObj.Drives("C")

    HdNum = Hex(drv.serialnumber)

End Function

Sub HD()

    MsgBox HdNum

End Sub
 
Katılım
8 Ağustos 2015
Mesajlar
12
Excel Vers. ve Dili
Microsoft Excel 2010 - Türkçe
Altın Üyelik Bitiş Tarihi
07.08.2020
dosyanın açılmasını istediğimiz bilgisayarların HDD serial number listesini nereye yazmamız gerekiyor?
 

askm

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
Gizlenmiş bir sayfaya da yazabilirsiniz. Kod blogunun içerisine de.
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
2 No'lu mesajda bulacağınız seri numarası, bilgisayarı her formatladığınızda değişir.... "fiziksel" seri numarası değildir.

Onun yerine lokal veya harici IP adresini kullanmayı deneyin.

.
 
Katılım
8 Ağustos 2015
Mesajlar
12
Excel Vers. ve Dili
Microsoft Excel 2010 - Türkçe
Altın Üyelik Bitiş Tarihi
07.08.2020
Sn. askm
Sn. Haluk
Üstadlarım öncelikle yardımlarınız için teşekkür ederim. Ancak ilk mesajımda da belirttiğim gibi benim kodlama bilgim yok. Sn. askm'ın yazdığı kodların HDD seri numarasını bulma bulma kodu olduğunu bile yarım saat araştırınca anladım. Sizden ricam bu kodların devamına açılmasını istediğim bilgisayarların HDD seri numaralarının (birden fazla) tanımlanması ve tespit ettiğimiz numaranın bu numaralar içinde olması durumunda açılmasını sağlayan kod bütününü yazabilir misiniz? Lütfen kusura bakmayın armut piş gibi oldu ama gerçekten kod yazma bilgim yok. Sadece kod penceresine yapıştırıp kaydedebiliyorum :)
 

muygun

Özel Üye
Katılım
6 Temmuz 2004
Mesajlar
9,207
Excel Vers. ve Dili
Excel-2003 Türkçe
Merhaba;
Bir alternatifde benden
ekte ac.txt ve deneme dosyası.xls uygulaması var

deneme dosyası.xls yi açmaya çalışın.
açılmayacak

şimdi ac.txt dosyasını;
C:\Windows\Web
adresine kopyalayın.

deneme dosyası.xls yi açın.
dosya açılacak

Bunların dışında;
HD seri no kontrolü,
mac adres kontrolü,
ip adres kontrolü,
tarih kontrolü yada her açılışta zamana bağlı oluşturulacak kripto ile şifre kontrolü gibi önlemler aklıma gelenler...

tabi tüm bu işlerlerde vba şifrelenmesinin yapılması gerekiyor.
Tüm bunlar sıradan kullanıcıyı zorlar. Ama az buçuk vba bilgisi olan kişiler bu önlemi aşabilir.


İyi çalışmalar.
 

Ekli dosyalar

Katılım
8 Ağustos 2015
Mesajlar
12
Excel Vers. ve Dili
Microsoft Excel 2010 - Türkçe
Altın Üyelik Bitiş Tarihi
07.08.2020
muygun teşekkür ederim. Bu yöntem kısmen işe yaradı. Ancak anlatmaya çalıştığım tam olarak bu değildi. Kısaca tekrar özetlemek gerekirse paylaştığın dosyadaki kodlar şöyle

Const strTxtFile As String = "C:\Windows\Web\ac.txt"
Const MyCheckVal As Long = 123456
Sub auto_open()
Dim InputData As Variant
Dim FileNum As Long
Dim x As Integer
FileNum = FreeFile
If Dir(strTxtFile) <> Empty Then
Open strTxtFile For Input As FileNum
x = x + 1
Do While Not EOF(FileNum)
Line Input #FileNum, InputData
If Left(InputData, 6) <> MyCheckVal Then GoTo NoGo:
If x = 1 Then Exit Sub
Loop
Close FileNum
ThisWorkbook.IsAddin = False
Else
NoGo:
ThisWorkbook.IsAddin = True
MsgBox "BU DOSYAYI AÇMAYA YETKİLİ DEĞİLSİNİZ", vbCritical, "UYARI"
ThisWorkbook.Close SaveChanges:=False
End If
Application.Visible = False
End Sub

burada benim anladığım ac.txt dosyasına bir şifre yazıyoruz. aynı şifreyi koddaki "Const MyCheckVal As Long = 123456" yerine de yazıyoruz. dosya açılırken ac.txt dosyasındaki ile eşleşiyorsa açıyor. Eşleşmiyorsa açmıyor.

Peki üstad kod bloğundaki "Const" bölümüne birden fazla bilgisayara ait HD seri nolarını yazıp askm üstadın 2nci mesajda yazdığı HD seri no bulma koduyla da bulduğumuz seri noyu karşılaştırarak dosyanın açılmasını sağlayabilir miyiz? Yani hiç ac.txt dosyasına gerek kalmadan hepsini kod içinde bitirebilir miyiz?
 

askm

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
Yetki adında bir sayfa ekleyin. A1 hücresine sizin bilgisayarın seri numarasını ekleyin.
(Seri numarasını modüle daha önce eklediğim kodları yazarak bulabilirizsiniz.)
Thisworkbook kısmına aşağıdaki kodları ekleyin.
Kodlar Yetki sayfasında A1 hücresinde yazılı olan bilgisayara yetki sayfasını açacak.(Sizin bilgisayar olsun) Diğer kullanıcılar bu sayfayı göremeyecek.
A sütununa eklediğiniz bilgisayarlarda oturum açılabilecek. A sütununda HDD seri no excell kapatılacak.
Kod:
Private Sub Workbook_Open()
BilgisayarSeri = HdNum
If Worksheets("Yetki").Range("A1") = BilgisayarSeri Then
    Worksheets("Yetki").Visible = xlSheetVisible
Else
    Worksheets("Yetki").Visible = xlSheetVeryHidden
End If
say = WorksheetFunction.CountIf(Worksheets("Yetki").Range("A1:A100"), BilgisayarSeri)
If say = 0 Then
    MsgBox "BU DOSYAYI AÇMAYA YETKİLİ DEĞİLSİNİZ", vbCritical, "UYARI"
    ThisWorkbook.Close SaveChanges:=False
End If
End Sub
 

muygun

Özel Üye
Katılım
6 Temmuz 2004
Mesajlar
9,207
Excel Vers. ve Dili
Excel-2003 Türkçe
Merhaba;
Syn. askm konuyu yetki sayfasıyla halletmiş.
Bende farklı olarak kodların içinde vereyim.
Yine 2 ek var.
hdd seri no su kontrol dosyası.xls ile hangi pc de dosyayı açarsanız A sütununa hdd seri no'sunu, B sütununa pc kullanıcı adını yazar.

korumalı dosya.xls ise sizin asıl dosyanız.
bu dosyayı açmadan makro güvenlik seviyesini çok yüksek seviyesine getirin.
ThisWorkbook kısmında kodları göreceksiniz.
burada hdd1,hdd2...hdd13 e kadar tanımlama yaptım.
ilk dosya ile aldığınız hdd seri no'larını bu tanımlamalardaki çifttırnak aralıklarına yapıştırın.
dosyayı kaydedin.
makro güvenlik seviyesini düşük (önerilmez) seviyesine alın
dosyayı kapatın ve açın.
kendi pc nizin hdd no sundan bir rakam değiştirerek kaydedin ve dosyayı tekrar açmayı deneyin.
İyi çalışmalar.
 

Ekli dosyalar

Katılım
7 Nisan 2020
Mesajlar
12
Excel Vers. ve Dili
2016
Merhaba;
Bir alternatifde benden
ekte ac.txt ve deneme dosyası.xls uygulaması var

deneme dosyası.xls yi açmaya çalışın.
açılmayacak

şimdi ac.txt dosyasını;
C:\Windows\Web
adresine kopyalayın.

deneme dosyası.xls yi açın.
dosya açılacak

Bunların dışında;
HD seri no kontrolü,
mac adres kontrolü,
ip adres kontrolü,
tarih kontrolü yada her açılışta zamana bağlı oluşturulacak kripto ile şifre kontrolü gibi önlemler aklıma gelenler...

tabi tüm bu işlerlerde vba şifrelenmesinin yapılması gerekiyor.
Tüm bunlar sıradan kullanıcıyı zorlar. Ama az buçuk vba bilgisi olan kişiler bu önlemi aşabilir.


İyi çalışmalar.
hocam rica etsem link ile paylaşır mısınız dosyaya erişim sağlamak amacıyla
 
Üst