Dosya bul

[gokhanbek]

Sub dayabul()
'
'

Columns("D").Select
Selection.ClearContents
Range("A1").Select

Klasor = Range("a1").Value
Dim Dosya As String
On Error Resume Next
Dosya = Dir(Klasor & "\*")
Do While Dosya <> ""
i = i + 1
Cells(i, "d").Value = Dosya
Dosya = Dir
Loop
End Sub


ŞEKLİNDE GİRDİĞİMDE DOSYALARI BULUYOR
BİDE KLASÖRLERİ BULSA SÜPER OLUR

İYİ ÇALIŞMALAR

 

[halit3]

Bu kod klasörleri a ve b sutünuna listeliyor.

 Dim Klasor As Object
Dim sut As String
Private Sub CommandButton1_Click()
Columns("A:B").ClearContents
sut = 1
Dim Klasor As Object
Set Klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasor seçin !", 1)
If Not Klasor Is Nothing Then
If InStr(1, Klasor, "{") > 0 Then GoTo Atla
Cells(1, 2) = Klasor
Liste (Klasor.SELF.Path)
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
Set Klasor = Nothing
End Sub
Private Sub Liste(Klasor As String)
Dim fL As Object, f As Object ', sut As Long
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(Klasor).SubFolders
Cells(sut, 1) = Klasor
sut = Cells(Rows.Count, "a").End(3).Row + 1
On Error GoTo sonraki
For Each f In fL
Cells(sut, 2) = f.Name
Liste (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub

 

[gokhanbek]

kod hata veriyor
birde bu secerek değilde a1 yolu olan dosyanın klasörleri olsa

 

[halit3]

kod hata veriyor
birde bu secerek değilde a1 yolu olan dosyanın klasörleri olsa

kod çalışıyor hatayı nerde alıyorsunuz.

 

[halit3]

a1 yolu olan dosyanın klasörleri olsa

Zaten 1. nolu mesajınızda dosyaya ait klasör al hücresinde mavcut

Klasor = Range("a1").Value

 

[gokhanbek]

Dim Klasor As Object
Dim sut As String

Private Sub CommandButton1_Click()
Columns("A:B").ClearContents
sut = 1
Dim Klasor As Object
Set Klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasor seçin !", 1)
If Not Klasor Is Nothing Then
If InStr(1, Klasor, "{") > 0 Then GoTo Atla
Cells(1, 2) = Klasor
Liste (Klasor.SELF.Path)
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
Set Klasor = Nothing
End Sub
Private Sub Liste(Klasor As String)
Dim fL As Object, f As Object ', sut As Long
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(Klasor).SubFolders
Cells(sut, 1) = Klasor
sut = Cells(Rows.Count, "a").End(3).Row + 1
On Error GoTo sonraki
For Each f In fL
Cells(sut, 2) = f.Name
Liste (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub

 

[halit3]

GetFold er

yukarıdaki kodun arasındaki boşluğu al kodları buraya aktarınca sistem bunu otomatik ayırıyor

GetFolder

 

[gokhanbek]

hata yine viriyor ve sadece secilen klasörün ismini yazıyor

office2010 kullanıyorum

 

[gokhanbek]

Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(Klasor).SubFolders

 

[halit3]

hata yine viriyor ve sadece secilen klasörün ismini yazıyor

office2010 kullanıyorum

4 nolu mesajdaki gönderdiğim dosyada hata uyarısı alıyormusunuz.

 

[gokhanbek]

Evet hata veriyor AYNI HATA

 

[halit3]

Evet hata veriyor AYNI HATA

Sorun herhalde referenslarla ilgili

Kod sayfasındaki Tools / References'lara bakın "Missing" ile başlayan referansın kutusunu silip, kaydetin. Dosyayı tekrar açın bakalım.

genede olmadıysa ekran görüntüsünü ekleyin bir bakalım.

 

[gokhanbek]

sorun herhalde referenslarla ilgili

kod sayfasındaki tools / references'lara bakın "missing" ile başlayan referansın kutusunu silip, kaydetin. Dosyayı tekrar açın bakalım.

genede olmadıysa ekran görüntüsünü ekleyin bir bakalım.

ilşallah olur sizede zahmet oldu

 

[halit3]

ofis 2007 de çalışıyor her halde ofis 2010 la ilgili bir sorun ama ilk aklıma lisansla ilgili geliyor

 

[gokhanbek]

2007 yedide çalıştı 2010 çalışmadı

başka bir çözüm yolu varmı