• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kod Hakkında Yardım

  • Konbuyu başlatan Konbuyu başlatan askm
  • Başlangıç tarihi Başlangıç tarihi

askm

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,746
Excel Vers. ve Dili
2010-2016
Kolay gelsin.
Aşağıdaki kodlar ile seçtiğim klasörün içeriğini listeliyorum. Listelediğim özelliğe ek eklemek istiyorum. (son güncelleme tarihi, kaydeden gibi) Nasıl eklerim.
Teşekkürler.

Dim Klasor As Object
Dim sat As String
Sub bul()
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
Kaynak = Klasor.SELF.Path
sat = 2
If Not Klasor Is Nothing Then
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
Application.ScreenUpdating = False
Range("A2:D" & Rows.Count).ClearContents
'Columns("A:C").ClearContents
Liste (Kaynak)
Application.ScreenUpdating = True
MsgBox "işlem tamam !", vbInformation, "DİKKAT"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
Private Sub Liste(Klasor As String)
Dim fL As Object, f As Object, Dosya As String
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(Klasor).SubFolders
sat1 = sat
Dosya = Dir(Klasor & "\*.**")
While Dosya <> ""
DoEvents

Cells(sat1, 1).Value = Klasor
Cells(sat1, 2).Value = Dosya

'deg = Dosya
For i = Len(Dosya) To 1 Step -1
If Mid(Dosya, i, 1) = "." Then
Cells(sat1, 3).Value = Mid(Dosya, 1, i - 1)
Cells(sat1, 4).Value = Mid(Dosya, i + 1, 4)
Exit For
End If
Next


sat1 = sat1 + 1
Dosya = Dir
Wend
sat = sat1
On Error GoTo sonraki
For Each f In fL
Liste (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub
 
İlginiz için teşekkürler. Hücrenin güncelleme tarihini istemiyorum. Dosyanın en son güncelleme tarihi vb. gerekli
 
Geri
Üst