Klasör içindeki dosyaların takibi

[ermanusta]

merhaba excel dosyasını çalıştırdığım klasör içerisindeki diğer dosya adları/alt klasörlerdeki dosya adları ve bu dosyalara uzanan bir bağlantı yapabilirmiyiz.

örnek: c:/deneme.xls çalıştırıldığında
c:/dosya.pdf
c:/dosya2.jpg
c:/dosya3.xls
c:/yeni klasör/dosya5.pdf
c:/yeni klasör/yeni klasör.....

gibi yani içinde bulunduğu klasörlerin tamamını daha sonradan düzenleyebileceğim bir sayfa ve stün da klasör adı altında bağlantılı bir şekilde görebilmem mümkün mü ?
amacım klasörlediğim bilgileri excel dosyasında görüp kısa yoldan ulaşmak, çok fazla dosya var ve araması zor bir durum.

 

[muysun35]

Bir forma btnara ismli bir düğme ve comsonuc isimli bir combobox yerleştirmeniz yeterli.
Dosyaları bulup combobox a atar.

Private Sub btnara_Click()
comsonuc.Clear
comsonuc.Refresh

Dim arama As Object
Dim aradosya As Object

Set arama = CreateObject("FileSearch.Search")
Call arama.SearchFiles("C:", "*.*", True)
DoEvents
If arama.Files.Count > 0 Then

For Each aradosya In arama.Files
comsonuc.AddItem aradosya.FileName
Set aradosya = Nothing
Next
End If

Set arama = Nothing
comsonuc.text="ARAMA BİTTİ"
End Sub

'Alıntıdır

 

[muysun35]

Bu da başka bir örnek
Alıntıdır.

Function CreateFileList(FileFilter As String, _
IncludeSubFolder As Boolean) As Variant
Dim FileList() As String, FileCount As Long
CreateFileList = ""
Erase FileList
If FileFilter = "" Then FileFilter = "*.*" ' all files
With Application.FileSearch
.NewSearch
.LookIn = CurDir
.Filename = FileFilter
.SearchSubFolders = IncludeSubFolder
.FileType = msoFileTypeAllFiles
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) = 0 Then Exit Function
ReDim FileList(.FoundFiles.Count)
For FileCount = 1 To .FoundFiles.Count
FileList(FileCount) = .FoundFiles(FileCount)
Next FileCount
.FileType = msoFileTypeExcelWorkbooks ' reset filetypes
End With
CreateFileList = FileList
Erase FileList
End Function

Sub TestCreateFileList()
Dim FileNamesList As Variant, i As Integer
'ChDir "C:My Documents"
FileNamesList = CreateFileList("*.*", False)
Range("A:A").ClearContents
For i = 1 To UBound(FileNamesList)
Cells(i + 1, 1).Formula = FileNamesList(i)
Next i
End Sub