Listbox yardım

[hlojan]

"A:\ " da bulunan doc dosyalarını listelemek için kullandığım kodu listboxa nasıl yaparım

Ama direk listboxa veri alacak. Excel sayfasını kullanmayacak

arama butonu olcak birde

Private Sub CommandButton1_Click()

Kaynak = "b:\"
Range("A2:f65000").ClearContents
If Right(Kaynak, 1) <> "\" Then Kaynak = Kaynak & "\"
Liste (Kaynak)
MsgBox "işlem tamam"
End Sub


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

For Each Dosya In fL.GetFolder(yol).Files
If ThisWorkbook.Name = Dosya.Name Then GoSub atla
If "~$" & ThisWorkbook.Name = Dosya.Name Then GoSub atla

j = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("a2:a" & Rows.Count)) + 2
Cells(j, 1) = Dosya
Cells(j, 2).Value = fL.GetBaseName(fL.GetParentFolderName(Dosya))
Cells(j, 3) = Dosya.Name
Cells(j, 4) = fL.GetBaseName(Dosya)
Cells(j, 5).Hyperlinks.Add Anchor:=Cells(j, 5), Address:=Dosya, TextToDisplay:="Aç" 'fL.GetBaseName(Dosya)
atla:
Next

On Error GoTo sonraki
For Each f In fL.GetFolder(yol).SubFolders
Liste (f.Path)
sonraki:
Next

Set fL = Nothing
End Sub

 

[halit3]

kod:

Private Sub CommandButton1_Click()
Kaynak = "b:\"
Liste (Kaynak)
MsgBox "işlem tamam"
End Sub


Private Sub Liste(yol As String)
Dim fL As Object, fs As Object, f As Object
Set fL = CreateObject("Scripting.FileSystemObject")

For Each Dosya In fL.GetFolder(yol).Files
If ThisWorkbook.Name = Dosya.Name Then GoSub atla
If "~$" & ThisWorkbook.Name = Dosya.Name Then GoSub atla

uzanti = LCase(fL.GetExtensionName(Dosya))
If uzanti = "doc" Then
ListBox1.AddItem Dosya
End If

atla:
Next

On Error GoTo sonraki
For Each f In fL.GetFolder(yol).SubFolders
Liste (f.Path)
sonraki:
Next

Set fL = Nothing
End Sub