No announcement yet.

Script for file search

  • Filter
  • Time
  • Show
Clear All
new posts

  • Script for file search

    Hi i would like to get som info if ther is somebody tha knows how to script VBA for ex to obtain the dir and sub dir s vhith its content to a teext file .
    for ex i would likte to search for *.ini in dir x whit subdir etc so tha i can replace ini files with updates files /best regards S

  • #2
    Re: Script for file search

    this i s what i have done so far..
    I would like to use wildcards to search fore.
    Sub TestListFilesInFolder()
    Dim strMapp As String
    strMapp = InputBox("Ange mapp fِr sِkning av filer", "My list of files 2003©", "")
    With Range("A1")
    .Value = "Mapp innehهll 2003 ©"
    .Font.Bold = True
    .Font.Size = 12
    End With
    Range("A2") = "Filnamn"
    Range("B2") = "Filstorlek"
    Range("C2") = "Filtyp"
    Range("D2") = "Skapad"
    Range("E2") = "Senast anvنnd"
    Range("F2") = "Senast نndrad:"
    Range("G2") = "Attribut"
    Range("H2") = "Dosnamn:"
    Range("A2:H2").Font.Bold = True
    ListFilesInFolder strMapp, True
    End Sub

    Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)

    Dim FSO As Scripting.FileSystemObject
    Dim fldMapp As Scripting.Folder, fldUnderMapp As Scripting.Folder
    Dim Fil As Scripting.File
    Dim lngRad As Long

    Set FSO = New Scripting.FileSystemObject
    Set fldMapp = FSO.GetFolder(SourceFolderName)
    lngRad = Range("A65536").End(xlUp).Row + 1
    For Each Fil In fldMapp.Files
    Cells(lngRad, 1) = Fil.Path
    Cells(lngRad, 2) = Format(Fil.Size, "# ##") & " byte"
    Cells(lngRad, 3) = Fil.Type
    Cells(lngRad, 4) = Fil.DateCreated
    Cells(lngRad, 5) = Fil.DateLastAccessed
    Cells(lngRad, 6) = Fil.DateLastModified
    Cells(lngRad, 7) = Fil.Attributes
    Cells(lngRad, 8) = Fil.ShortPath

    lngRad = lngRad + 1
    Next Fil
    If IncludeSubfolders Then
    For Each fldUnderMapp In fldMapp.SubFolders
    ListFilesInFolder fldUnderMapp.Path, True
    Next fldUnderMapp
    End If
    Set Fil = Nothing
    Set fldMapp = Nothing
    Set FSO = Nothing
    ActiveWorkbook.Saved = True
    End Sub