Her zaman değişebilen dosya yoluna rağmen yolunu şaşırmayan makro kodu!

[antonio]

Dosya yolu ile ilgili web üzerinde yaptığım tüm araştırmalarda; nedense dosya yolunun, makro kodu ile mutlak bir şekilde tanımlandığını fark ettim. ("C:\Kullanıcılar\Kullanıcı\....\...xls" gibi). Ben bu tarz dosya yolu tanımları istemiyorum. Benim dosyam C, F, G, X, D, H gibi sayısız farklı sürücü altında ve her seferinde apayrı bir yerde olabilir. Bu yüzden bağımsız, değişken olabilen bir dosya yolu tanımına ihtiyaç duyuyorum. Durumu örnekle daha da açarsak:
Çalışmalarımın tümü "XXX" Klasöründe olsun. Bu klasörümün içindeki excel dosyalarımda birbiriyle bağlantılı çalışmalar yapıyorum. Ayrıca "XXX" Klasörümün içinde "images", "audio", "data" gibi alt klasörlerim de var bunlara da bağlanma ihtiyacı duyuyorum. "XXX" klasörü bazen hafıza çubuğunda bir yerlerde, ve her bilgisayarda apayrı bir yerde olsa bile, başka bir deyişle nereye kaydederseniz edin, makro kodlarımda kullandığım dosya yolu, direk olarak "XXX" klasörünü, bulabilmeli, bu klasör içinde ki başka bir dosyayı bulabilmeli, yada bu klasörün alt klasöründe ki hedef dosyayı seçebilmelidir. Yani esnek ve her durumda çalışır olmalıdır. ("Bu çalışma kitabımın olduğu klasöre göre şuraya git, buraya git" gibi bir komut arıyorum).
"XXX" Klasörünü nereye kaydedersen et, onu bulup ilgili alt klasöre yada dosyaya gidecek dosya yolu kodunu nasıl yazabilirim?
Yardımcı olacak arkadaşlara önceden teşekkürler.

 

[halit3]

Dosya yolu ile ilgili web üzerinde yaptığım tüm araştırmalarda; nedense dosya yolunun, makro kodu ile mutlak bir şekilde tanımlandığını fark ettim. ("C:\Kullanıcılar\Kullanıcı\....\...xls" gibi). Ben bu tarz dosya yolu tanımları istemiyorum. Benim dosyam C, F, G, X, D, H gibi sayısız farklı sürücü altında ve her seferinde apayrı bir yerde olabilir. Bu yüzden bağımsız, değişken olabilen bir dosya yolu tanımına ihtiyaç duyuyorum. Durumu örnekle daha da açarsak:
Çalışmalarımın tümü "XXX" Klasöründe olsun. Bu klasörümün içindeki excel dosyalarımda birbiriyle bağlantılı çalışmalar yapıyorum. Ayrıca "XXX" Klasörümün içinde "images", "audio", "data" gibi alt klasörlerim de var bunlara da bağlanma ihtiyacı duyuyorum. "XXX" klasörü bazen hafıza çubuğunda bir yerlerde, ve her bilgisayarda apayrı bir yerde olsa bile, başka bir deyişle nereye kaydederseniz edin, makro kodlarımda kullandığım dosya yolu, direk olarak "XXX" klasörünü, bulabilmeli, bu klasör içinde ki başka bir dosyayı bulabilmeli, yada bu klasörün alt klasöründe ki hedef dosyayı seçebilmelidir. Yani esnek ve her durumda çalışır olmalıdır. ("Bu çalışma kitabımın olduğu klasöre göre şuraya git, buraya git" gibi bir komut arıyorum).
"XXX" Klasörünü nereye kaydedersen et, onu bulup ilgili alt klasöre yada dosyaya gidecek dosya yolu kodunu nasıl yazabilirim?
Yardımcı olacak arkadaşlara önceden teşekkürler.

Esasında kodları yazmakta baya teretdütlüydüm şimdi bu kodları nasıl kullanacaksınız bilmiyorum.

Kod öncelikle aradığınız klasörü bilgisayarın içinde bulacak tabi bu bilgisayarınızın hızına göre ve disklerin kapasitesine göre zaman alacaktır her seferinde bu klasörü bulması oldukça zaman kaybı ve sıkıcı olacağını düşünüyorum.

Aranan klasör birden fazla sürücüde veya farklı klasörlerin içinde birden fazla olursa ne olacak.

1-Sayfa2 de A1 hücresine bilgisayarda aradığın klasörün adını yaz ve komut düğmesini tıkla
2-Sayfa1 deki komut düğmesine tıkla

Not:Sayfa2 deki komut düğmesine bir defalık tıklıyacaksınız ve sayfa1 deki komut düğmesine tıklayınca eğer daha önce işlem yaptığınız klasörü bulamazsa sayfa1 deki hücreler siliniyor o zaman tekrar sayfa2 deki komut düğmesine tıklıyacaksınız.

Uyarı: Bu kodun amacı bilinmeyen bir klasörü aramak ve adresini bulmaktır.

 

[antonio]

Halit Bey ilginiz için teşekkür ederim. Yeterince açık anlatamadığımı düşünüyorum. Bir dosyaya gitmek için hareket noktası olarak:
1) C, D, X, ... sürücüsü ve onun alt klasörleri sıralanır, ilgili klasörde ki dosya bulunur. (Benim işime yaramayan yöntem.)
2) Benim işim zaten "XXX" klasörünün içinde ki dosyalardan biriyle ilgili. Çalışma kitabımda orada. O halde hareket noktasının "Bu çalışma kitabımın içinde olduğu Klasör" kodu; benim aradığım ve en kullanışlı bulduğum koddur. Yani bilgisayarda klasör ismi ile arama yapmaya gerek yok.

Saygılarımla.

 

[halit3]

Dosyanın bulunduğu klasör

ThisWorkbook.Path

 

[antonio]

Dosyanın bulunduğu klasör

ThisWorkbook.Path

Dosyanın bulunduğu klasörde ki "bilgi" alt klasöründe bulunan "veritaban.mdb" yolunu tanımlarsak nasıl yazmamız lazım?

 

[halit3]

Dosyanın bulunduğu klasörde ki "bilgi" alt klasöründe bulunan "veritaban.mdb" yolunu tanımlarsak nasıl yazmamız lazım?

Dosyanın adını Uzantısını yazmadan A1 hücresine yaz ve aşağıdaki komut düğmesini tıkla

kod:

Private Sub CommandButton1_Click()
Liste1 (ThisWorkbook.Path)
MsgBox "işlem tamam"
End Sub


Private Sub Liste1(yol As String)
Dim fs As Object, f As Object, j As Long
Set fs = CreateObject("Scripting.FileSystemObject")

For Each Dosya In fs.GetFolder(yol).Files
j = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("A1:A" & Rows.Count)) + 1

dosya_adi = fs.GetBaseName(Dosya)
If Cells(1, 1).Value = dosya_adi Then
Cells(j, 1).Value = Dosya
End If

Next


On Error GoTo sonraki
For Each f In fs.GetFolder(yol).subfolders
Liste1 (f.Path)
sonraki:
Next


Set fL = Nothing
End Sub

 

[antonio]

Dosyanın adını Uzantısını yazmadan A1 hücresine yaz ve aşağıdaki komut düğmesini tıkla

Halit Hocam tebrikler ve sonsuz teşekkürler.. Beyninize ve paylaşımcı yüreğinize sağlık..

 

[thugangel]

aşağıdaki kodu dosyamı istediğim zaman yedek almak için oluşturdum. A10 hücresinde yazılı hedef klasöre kopyalamak istiyorum ancak hedef klasör yolunu bir türlü tanımlayamadım. yardımcı olursanız sevinirim.


Dim ds
Set ds = CreateObject("Scripting.FileSystemObject")
hedef = Range("A10").Value
ds.CopyFile "D:\DENEME\*.xls", "hedef"

 

[halit3]

aşağıdaki kodu dosyamı istediğim zaman yedek almak için oluşturdum. A10 hücresinde yazılı hedef klasöre kopyalamak istiyorum ancak hedef klasör yolunu bir türlü tanımlayamadım. yardımcı olursanız sevinirim.


Dim ds
Set ds = CreateObject("Scripting.FileSystemObject")
hedef = Range("A10").Value
ds.CopyFile "D:\DENEME\*.xls", "hedef"

Kod:

Dim ds
Set ds = CreateObject("Scripting.FileSystemObject")
hedef = Range("A10").Value ' burada yazılı sürücü,klasör. dosya bilgisayarınızda var olmalı
yer = "D:\DENEME\örnek.xls"
ds.CopyFile yer, hedef

 

[BedriA]

Dosyanın bulunduğu klasör

ThisWorkbook.Path

Halit Hocam,

Bu klasörün içindeki "X" klasörünü nasıl göstereceğiz?
Aşağıdaki kırmızı yazılı şekilde denedim, olmadı.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [D2:D100,F2:F100]) Is Nothing Then Exit Sub
yatay = 1 ' bu kadar hücre sağa kayacak
dikey = 0  ' bu kadar hücre aşağıya kayacak
Dim s1
Set s1 = Sheets(ActiveSheet.Name)
If InStr(Trim(ActiveWindow.RangeSelection.Address), ":") = 0 Then
Set Adres = s1.Cells(Target.Row + dikey, Target.Column + yatay)

Dim Picture As Object
For Each Picture In s1.Shapes
If TypeName(s1.Shapes(Picture.Name).OLEFormat.Object) = "Picture" Then

Set yer = s1.Cells(Picture.BottomRightCell.Row, Picture.BottomRightCell.Column)
If yer.Address = Adres.Address Then
Picture.Delete
Exit For
End If
End If
Next Picture

ReDim uzanti(11)
uzanti(1) = "bmp":        uzanti(2) = "jpg"
uzanti(3) = "gif":        uzanti(4) = "png"
uzanti(5) = "jpeg"

For j = 1 To 5

[COLOR="Red"]dosya = "ThisWorkbook.Path\Sorular5" & "\" & Target.Value & "." & uzanti(Val(j))[/COLOR]

If CreateObject("Scripting.FileSystemObject").FileExists(dosya) = True Then
's1.Shapes.AddPicture Dosya, msoFalse, msoCTrue, Range(Adres).Left + 2, Range(Adres).Top + 2, Range(Adres).Width - 4, Range(Adres).Height - 4
ad = s1.Pictures.Insert(dosya).Name
s1.Shapes(ad).OLEFormat.Object.ShapeRange.LockAspectRatio = msoFalse

s1.Shapes(ad).OLEFormat.Object.Top = Adres.Top + 2
s1.Shapes(ad).OLEFormat.Object.Left = Adres.Left - 2
s1.Shapes(ad).OLEFormat.Object.ShapeRange.Height = Adres.Height - 50
s1.Shapes(ad).OLEFormat.Object.ShapeRange.Width = Adres.Width - 2
s1.Shapes(ad).OLEFormat.Object.Name = Target.Address
s1.Cells(Target.Row + 1, Target.Column).Select

Exit For
End If
Next

End If
End Sub

 

[halit3]

C sürücüsünden vazgeçtiğiniz anlaşılıyor isabetli olmuş

dosya = ThisWorkbook.Path & "\Sorular5\" & Target.Value & "." & uzanti(Val(j))

 

[BedriA]

C sürücüsünden vazgeçtiğiniz anlaşılıyor isabetli olmuş

dosya = ThisWorkbook.Path & "\Sorular5\" & Target.Value & "." & uzanti(Val(j))

Hocam C'de olması sıkıntılı, program paylaşıldığı zaman.
Bu arada; sayenizde çok şey öğrendim, çok sağolun.

Hocam Visual Studio kullanabiliyor musunuz?

 

[BedriA]

C sürücüsünden vazgeçtiğiniz anlaşılıyor isabetli olmuş

dosya = ThisWorkbook.Path & "\Sorular5\" & Target.Value & "." & uzanti(Val(j))

Halit Hocam şimdi deneme fırsatım oldu, bu şekilde çalışmıyor.
Aşağıdaki şekilde kullandım.

dosya = ThisWorkbook.Path & "Azmun\Sorular5\" & Target.Value & "." & uzanti(Val(j))

 

[BedriA]

Aşağıdaki şekilde kullanınca çalıştı.
Çok teşekkürler Halit hocam.

dosya = ThisWorkbook.Path & "\Azmun\Sorular5" & "\" & Target.Value & "." & uzanti(Val(j))