"D:\Sirket.txt" dosyasını birden fazla sürücüde a

[Ongun]

Günaydın arkadaşlar,

Aşağıdaki kodlarda (Sayın Haluk bey`e ait) "D:\Sirket.txt" txt dosyasını D sürücüsündü arıyor bulursa program çalışıyor. Programı sadece Cd`de tanıtmak istiyorum, Sirket.txt dosyası cd`de kayıtlı ve Folder Access ile şifreli buraya kadar bir sorunum yok.

Sorum şöyle, yapmak istediğim sadece D:C:G:F:E sürücüleri hangisi olursa arasın (yani hangisinde bulursa ) o zaman çalışsın. Bunu istememin sebebi "D:\Sirket.txt" şekilde yazdığımızda başka bilgisayarlarda örneğin sürücüleri G ve F olabiliyor. Bu defa siz D sürücüsünde ara "D:\Sirket.txt" dediğiniz için HATA veriyor.

Lütfen bu konuda bana yardımcı olurmusunuz. Saygılarımla :dua:


Const strTxtFile As String = "D:\Sirket.txt"

Sub Autpen()
If Dir(strTxtFile) <> Empty Then
ThisWorkbook.IsAddin = False
Else
ThisWorkbook.IsAddin = True
MsgBox "Kayitli kullanici degilsiniz....", vbCritical, "Kullanicinin dikkatine !"
ThisWorkbook.Close SaveChanges:=False
End If
End Sub

 

[omerceri]

xls dosyanızla txt dosyanızı aynı klasöre koyup yolunu aşağıdaki gibi belirtirseniz. istediğiniz sürücüye kopyalıyabilirsiniz.
Const strTxtFile As String = ThisWorkbook.Path & ":\Sirket.txt"
Edit:Const strTxtFile As String = ThisWorkbook.Path & "\Sirket.txt"

 

[Ongun]

Sayın omerceri, öncelikle ilginiz için teşekkür derim. Galiba yanlış anlaşılma oldu. Diyelimki cd`de kayıtlı dosyalarım şunlar: Deneme.xls ve Sirket.txt.

Benim istediğim program sadece cd`den kullanılabilsin eğer kullanıcı programı kendi bilgisayarına kopyalayıp çalıştırmak isterse "kayıtlı kullanıcı değilsiniz" diye mesaj versin.

Lütfen bana yardım edermisiniz. Saygılarımla :dua:

 

[omerceri]

Kodu aşağıdaki gibi değiştirirseniz
Sub Autpen()
Dim fs, d, dc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each d In dc
If d.DriveType = 4 Then
s = d.DriveLetter
End If
Next
strTxtFile = s & ":\Sirket.txt"
If Dir(strTxtFile) <> Empty Then
ThisWorkbook.IsAddin = False
Else
ThisWorkbook.IsAddin = True
MsgBox "Kayitli kullanici degilsiniz....", vbCritical, "Kullanicinin dikkatine !"
ThisWorkbook.Close SaveChanges:=False
End If
End Sub

 

[omerceri]

Kusura bakmayın ilk önce düşünedim.
CD yazıcıda olabilir Pc de, kodları aşağıdaki gibi değiştirip, devamlı CD okuyucuda çalışırsanız.
Sub Autpen()
Dim fs, d, dc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each d In dc
If d.DriveType = 4 Then
s = d.DriveLetter
exit for
End If
Next
strTxtFile = s & ":\Sirket.txt"
If Dir(strTxtFile) <> Empty Then
ThisWorkbook.IsAddin = False
Else
ThisWorkbook.IsAddin = True
MsgBox "Kayitli kullanici degilsiniz....", vbCritical, "Kullanicinin dikkatine !"
ThisWorkbook.Close SaveChanges:=False
End If
End Sub

 

[omerceri]

El yordamı ile bu kadar oluyor bu sefer denedim. tekrar tekrar özür dilerim.
Sub Autpen()
Dim fs, d, dc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each d In dc
If d.DriveType = 4 Then
s = d.DriveLetter
Exit For
End If
Next
If dc(s & ":").IsReady Then
strTxtFile = s & ":\Sirket.txt"
If Dir(strTxtFile) <> Empty Then
ThisWorkbook.IsAddin = False
Else
ThisWorkbook.IsAddin = True
MsgBox "Kayitli kullanici degilsiniz....", vbCritical, "Kullanicinin dikkatine !"
ThisWorkbook.Close SaveChanges:=False
End If
Else
ThisWorkbook.IsAddin = True
MsgBox "CD Okuyucuya Program CD'ni takınız"
ThisWorkbook.Close SaveChanges:=False
End If
End Sub

 

[omerceri]

Cd okuyucu da Cd yazıcıya da konulsa çalışır.
Sub Autpen()
Dim fs, d, dc, s, a
a = 0
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each d In dc
If d.DriveType = 4 Then
s = s & d.DriveLetter
a = a + 1
End If
Next

If a = 1 And dc(Left(s, 1) & ":").IsReady Then

If Dir(Left(s, 1) & ":/Sirket.txt") <> Empty Then
ThisWorkbook.IsAddin = False
Else
ThisWorkbook.IsAddin = True
MsgBox "Kayitli kullanici degilsiniz....", vbCritical, "Kullanicinin dikkatine !"
ThisWorkbook.Close SaveChanges:=False

End If

ElseIf a = 2 And dc(Right(s, 1) & ":").IsReady Then
If Dir(Right(s, 1) & ":/Sirket.txt") <> Empty Then
ThisWorkbook.IsAddin = False
Else
ThisWorkbook.IsAddin = True
MsgBox "Kayitli kullanici degilsiniz....", vbCritical, "Kullanicinin dikkatine !"
ThisWorkbook.Close SaveChanges:=False
End If

ElseIf a = 2 And dc(Left(s, 1) & ":").IsReady Then
If Dir(Left(s, 1) & ":/Sirket.txt") <> Empty Then
ThisWorkbook.IsAddin = False
Else
ThisWorkbook.IsAddin = True
MsgBox "Kayitli kullanici degilsiniz....", vbCritical, "Kullanicinin dikkatine !"
ThisWorkbook.Close SaveChanges:=False
End If

Else
ThisWorkbook.IsAddin = True
MsgBox "Program Cd'si Yok"
ThisWorkbook.Close SaveChanges:=False
End If

End Sub

 

[Ongun]

Sayın omerceri, ellerinize yüreğinize sağlık, çok teşekkür ederim. k::

Bu konuyla ilgili bir sorum daha olacak, Sirket.txt için CD`den okutmak istedik ve bu tamam peki gif ve Belge.doc olarak CD`de kayıtlı iki dosyayı daha okutmak istersek kodları nasıl düzenleyebilirim.

Saygılarımla :dua:

 

[omerceri]

kodlarda
"Dir(Right(s, 1) & ":/Sirket.txt") <> Empty"
bulunan satırları,
"Dir(Right(s, 1) & ":/Sirket.txt") <> Empty or Dir(Right(s, 1) & ":/Belge.doc") <> Empty or or Dir(Right(s, 1) & ":/dosyadı.gif") <> Empty"
şeklinde değiştirirsen

 

[Ongun]

Sayın omerceri, çok özür dilerim yine anlatamadım, benim yapmak istediğim Userform üzerinde "ataturk.gif" resmi var yani userform aktif olunca Atatürk resmi görünür oluyor. Bir de Bel1.doc diye bir word belgesi var.


Private Sub UserForm_Initialize()
WebBrowser1.Navigate ":/ataturk.gif"
End Sub

Word belgesinin kodları
With owordApp
.Visible = False
.Documents.Open (":/Bel1.doc")


Sorum şöyle programı CD`den çalıştırdığımda bu iki dosyayıda cd`den kontrol etsin, yani Atatürk resmi userform`da görünür olsun ve word belgesi (Bel1.doc) üzerinde işlem yapılabilsin.

Yardımcı olursanız çok sevinirim. Saygılarımla :dua:

 

[omerceri]

Private Sub UserForm_Initialize()
WebBrowser1.Navigate ":/ataturk.gif"
End Sub
şelindeki k0du

Private Sub UserForm_Initialize()
WebBrowser1.Navigate ThisWorkbook.Path & "/ataturk.gif"
End Sub
şekilde,


With owordApp
.Visible = False
.Documents.Open (":/Bel1.doc")
seklindeki kodu ise

With owordApp
.Visible = False
.Documents.Open (ThisWorkbook.Path & "/Bel1.doc")
şeklinde
değiştirirsen

 

[Ongun]

Sayın omerceri, ellerinize yüreğinize sağlık, çok teşekkür ederim. :mutlu:

Saygılarımla