Excel Dosyasının Tam Adresini Bulmak

[baydeniro]

Merhaba arkadaşlar. Bir excel dosyasının A1 hücresine yazdığımız bir excel dosyasının bulunduğu kataloğu bilmiyoruz. Bu dosyanın tam adresini bulmanın bir yolu var mı dır ?

Yani dosya C:\ altında olabilir,D:\ altında olabilir. Dosyanın adının EXCEL EGITIM olduğunu varsayalım !!

 

[Orion1]

Buyurunuz.

ThisWorkbook.Path

 

[baydeniro]

Teşekkür ederim sayın Orion1. Açık olan dosyanın adresini değil de, adı A1 hücresinde yazılı olan ve başka bir katalog altındaki dosyanın adresini bulmamız gerekiyor !!

 

[baydeniro]

Merhaba arkadaşlar. Bir excel dosyasının A1 hücresine yazdığımız bir excel dosyasının bulunduğu kataloğu bilmiyoruz. Bu dosyanın tam adresini bulmanın bir yolu var mı dır ?

Yani dosya C:\ altında olabilir,D:\ altında olabilir. Dosyanın adının EXCEL EGITIM olduğunu varsayalım !!

 

[halit3]

Alternatif kod A1 hücresine aranan dosya ismini yazınca C sütununa bulduğu dosyaları getiriyor.

Sub dosyabul()
Columns("C:C").ClearContents
On Error Resume Next
i = 1
Dim ds, dc, s
Set ds = CreateObject("Scripting.FileSystemObject")
Set dc = ds.Drives
For Each sürücü In dc
s = sürücü & "\"
AltListe (s)
Set Klasor = Nothing
i = i + 1
Next
MsgBox "işlem tamam"
End Sub

Private Sub AltListe(Yol As String)
Dim fL As Object, f As Object, Dosya As String, j As Long
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(Yol).SubFolders
Dosya = Dir(Yol & "\*.*")
While Dosya <> ""
DoEvents
j = [c65000].End(3).Row + 1
If Dosya Like Range("a" & 1).Value & "*" = True Then
Cells(j, 3) = Yol & "\" & Dosya
End If
Dosya = Dir
Wend
On Error GoTo sonraki
For Each f In fL
AltListe (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub

 

[baydeniro]

Harikasınız sayın halit3, çok ilginç bir kod. Sağlıcakla kalın.