klasör aramak

[zappari]

bana klasör arama metodu lazım ama
myfolder=("c:\budget\*",vbdirectory) kodundan farklı bişi olmalı
klasörleri tek tek almalıyom sadece klasörleri dosyaları değil.

 

[Recep İpek]

Aşağıdaki kodlar belki size fikir verebilir.

C sürücüsündeki klasörleri LİSTE sayfasına listeler.

Sub test4()
    Dim FSO As FileSystemObject
    Dim flds As Folders
    Dim yol As String
    Dim i As Integer
    Set FSO = New FileSystemObject
    Set flds = FSO.GetFolder("C:\").SubFolders
        Range("A2:A50").ClearContents
        i = 2
        For Each f In flds
            yol = f.Path
            Worksheets("LİSTE").Cells(i, 1) = yol
            i = i + 1
        Next
End Sub

 

[zappari]

tesekkür ederim

 

[cenk77ist]

dosya olusturulma tarihi

dosyalarin olusturulma yada son degistirilme tarihlerini excele nasil alabilirim???

 

[Haluk]

dosyalarin olusturulma yada son degistirilme tarihlerini excele nasil alabilirim???

'****************************************************
'*      Dosya Listeleme & Dosyalara Link kurmak     *
'*              Version 1.2.1 b                     *
'*                 Raider ®                         *
'*                Nisan 2003                        *
'****************************************************
'
Const MyExt As String = "*.xls"
Const IncludeSubFolder As Boolean = True
Dim MyPath As String
Dim FileSize, Folder, LastModified, LastAccessed
'
Sub FileList()
    Dim FileNamesList As Variant, i As Long
    Range("A:E").ClearContents
    On Error GoTo ErrHandler:
    Set objFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasor seçin !", 0)
        If Not objFolder Is Nothing Then
            MyPath = objFolder.Items.Item.Path
            If InStr(1, MyPath, Application.PathSeparator) < 1 Then Err.Raise (91)
                FileNamesList = CreateFileList(MyExt, IncludeSubFolder)
                Range("A1") = "Dosya Adı"
                Range("B1") = "Dosya Boyutu"
                Range("C1") = "Klasor"
                Range("D1") = "Son Değişiklik"
                Range("E1") = "Son Kullanma"
                Range("A1:E1").Font.Bold = True
                Range("A1:E1").Font.Size = 12
                Range("B:B").NumberFormat = "0.00 Kb"
                For i = 1 To UBound(FileNamesList)
                    Cells(i + 1, 1) = Dir(FileNamesList(i))
                    Call FileDetails(FileNamesList(i))
                    Cells(i + 1, 2) = FileSize
                    Cells(i + 1, 3) = Folder
                    Cells(i + 1, 4) = LastModified
                    Cells(i + 1, 5) = LastAccessed
                    ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 1, 1), Address:=FileNamesList(i)
                Next
                Columns("A:E").AutoFit
        End If
    Rows("2:2").Select
    ActiveWindow.FreezePanes = True
    Range("A1").Select
    Exit Sub
ErrHandler:
    Select Case Err.Number
        Case 7
        MsgBox "Disket veya CD-ROM/WRITER sürücüsü boş !", vbOKOnly, "HATA !"
        Case 13
        MsgBox "Klasorde geçerli *.xls dosyası bulunamadı !", vbOKOnly, "HATA !"
        Case 91
        MsgBox "Geçerli bir klasor seçilmedi !", vbOKOnly, "Hata !"
        Case Else
        MsgBox "Hata oluştu !" & vbCrLf & vbCrLf & "Hata No: " & Err.Number & vbCrLf & Err.Description, vbOKOnly, "HATA !"
    End Select
    Err.Clear
    Range("A1:E1").Clear
End Sub
'
Function CreateFileList(FileFilter As String, IncludeSubFolder As Boolean) As Variant
    Dim FileList() As String, FileCount As Long
    CreateFileList = ""
    Erase FileList
        With Application.FileSearch
            .NewSearch
            .LookIn = MyPath
            .Filename = FileFilter
            .LastModified = msoLastModifiedAnyTime
            .SearchSubFolders = IncludeSubFolder
            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
        End With
    CreateFileList = FileList
    Erase FileList
End Function
'
Sub FileDetails(FilePath)
    Dim fs, f
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(FilePath)
    FileSize = f.Size / 1024
    Folder = f.ParentFolder
    LastModified = Format(f.DateLastModified, "dd.mmmm.yyyy")
    LastAccessed = Format(f.DateLastAccessed, "dd.mmmm.yyyy")
    Set f = Nothing
    Set fs = Nothing
End Sub