VBA Excel - List Files & Characteristics

Finndelle Posted messages 1 Status Member -  
 liryc -
Hello,

I have a task to complete for my internship, but since it’s lengthy, I would like to use a macro with VBA to simplify it.

Actually, I need to list in an Excel workbook all the PowerPoint (.ppt) files that are in the folders and subfolders of the network (there are thousands of them...), including the title, location (as a hyperlink if possible), size, and number of slides:
Column A: Title
Column B: Number of slides
Column C: Size
Column D: Location (full detailed name, but also as a hyperlink)

I discovered VBA yesterday, and with the help of forums I put together this:
______________________________________________________
Sub Importationppt()
Dim ScanFic As Office.FileSearch
Dim NomFic As Variant
Dim Diag As String
Dim Nbr As Long
Dim I As Long
Set ScanFic = Application.FileSearch
With ScanFic
.NewSearch
.LookIn = "K:\Dept LIAISONS\DLS\Dossier LS"
.SearchSubFolders = True
.Filename = "ppt"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
Nbr = .Execute
Diag = Format(Nbr, "0 ""files found""")
I = 0
For Each NomFic In .FoundFiles
I = I + 1
Sheets("Feuil1").Cells(I, 1).Value = NomFic ' adapt the sheet name
Next
MsgBox Diag
End With
End Sub
______________________________________________________
It actually just puts the list of locations in column A... that’s all, but it’s already pretty good for a beginner!
I saw in the Visual Basic help that DocumentProperty could be added to retrieve everything I wanted, but I have no idea how to write that in the code… and then to also set up my requests in the corresponding columns, it’s really beyond my programming skills! ;-)

If someone experienced could write the corresponding code for me, it would really save my life! Otherwise, it will have to be done by hand... more tedious, I don't know!
And it’s for the week of 08/11/08... HELP!!
Thank you in advance!

Delphine

2 answers

  1. lucoli
     
    Hello,
    If it’s not too late or if the topic still interests you, I am ready to help you as I am retired and have done a lot of VBA.
    Best regards.
    0
    1. GESNOF
       
      Good evening,

      based on your exchanges, could you advise me:
      I have a sheet that contains in one column the names of servers and in the next four columns the existing shares on the server of that line in the first column
      I know how to "read" the servers and shares (up to an empty cell)
      however, I'm struggling with the issue:
      I need to count, on each of the \\server\share1 to 4 the files dated from yesterday and sum the total per server, whether on another sheet or not
      Thank you in advance for your response (even if negative)
      Best regards
      0
    2. alain3741
       
      Hello,
      I would like to reach out to you because I found on a website that you responded to someone regarding an Excel macro.
      I am also looking for an Excel macro that allows me to:

      List files from directories and subdirectories, and display for each file in a different column:
      the file name
      the path
      the file size
      the creation or last modification date,
      the file extension,
      ...

      Do you have something that could help me?
      Thank you in advance for the attention you will give to my request
      Best regards
      AAT
      amial@hotmail.fr
      0
      1. amial Posted messages 1 Status Member > Polux31 Posted messages 7219 Status Member
         
        Polux31,
        Thank you very much for your file, it helped me make good progress.
        I indeed retrieved what I needed.

        I took the opportunity, on the results page (sheet2), to add a conditional comparison that allowed me to color a row when it is identical to the one above or below (depending on the sorting). This way, I can sort similar files into the various directories.

        I now have a file with sometimes one or more colored rows in succession and each time a normal (non-colored) row.



        Do you have a solution to keep only the identical rows (colored and the compared non-colored row)?

        Thank you in advance for your help.
        Regards
        amial@hotmail.fr
        0
    3. Mike
       
      Hello, I am looking for a macro that would allow me to retrieve the size of a network folder in bytes (doesn't matter), into a cell.

      To date, I found this, but I have a bug and I don't know why...

      Sub NombreOctetsRepertoire()
      Dim Rep As Object
      Set Rep = CreateObject("Scripting.FileSystemObject")
      Range("H3") = Rep.GetFolder("\\server-name\").Size
      End Sub
      0
  2. liryc
     
    Bonjour,

    I am an industrial designer using Solid Edge and I need to list the plans I have created (file.dft).

    I am quite a novice in the VBA field, but I managed to "create" a code that:
    - lists the files in the folder and subfolders "Z:\My Work\Library\Interior Products\EMH Trolleys\CH200"
    - filters the file type as indicated in cell F19 (in this case .dft)
    - shows the creation date
    - adds the hyperlink
    ... but with thousands of files to process, it's way too slow!!!
    Is there a way to reduce the processing time?
    (Knowing that I am only filtering .dft files)

    Here is the code in question:
    Option Explicit

    Sub ScanWorkbooks()
    Dim Folder As Object, File As Object
    Dim Path As String, ThisFile As String, FileExt As String
    Dim FolderArray As Variant
    Dim L As Long, D As Long
    Dim pos As Byte
    Dim InitSB As Boolean

    InitSB = Application.DisplayStatusBar
    Application.DisplayStatusBar = True

    Path = "Z:\My Work\Library\Interior Products\EMH Trolleys\CH200"

    If Path = "" Then Exit Sub
    Application.ScreenUpdating = False
    ThisWorkbook.Sheets("ListDFT").Range("A2:C65536").Delete Shift:=xlUp
    ThisFile = ThisWorkbook.Name
    FileExt = UCase(Trim(ThisWorkbook.Sheets("ListDFT").Range("Extension").Text))
    L = 1
    'Creating the array of existing subfolders
    FolderArray = GetSubFolders(Path, True)
    For D = 1 To UBound(FolderArray)
    'Path of the folder (or subfolder) to analyze
    Path = FolderArray(D)
    If Right(Path, 1) <> "\" Then Path = Path & "\"
    'Analyzing the folder (or subfolder)
    Set Folder = CreateObject("Scripting.FileSystemObject").GetFolder(Path)
    For Each File In Folder.Files
    If File.Name <> ThisFile Then
    If FileExt = "" Or UCase(Right(File.Name, 3)) = FileExt Then
    'Listing the files
    L = L + 1
    '
    Application.StatusBar = "Processed line: " & L
    'Updating result sheet
    With ThisWorkbook.Sheets("ListDFT")
    .Cells(L, 1).Value = Path
    .Hyperlinks.Add Anchor:=.Cells(L, 2), Address:=Path & File.Name, _
    TextToDisplay:=File.Name
    .Cells(L, 3).Value = File.DateCreated

    End With

    End If
    End If
    Next
    Next D

    Columns("B:B").Select
    Range("A1:C65536").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _
    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
    Range("A1").Select

    Set Folder = Nothing
    'Restores the link alert in Excel options
    Application.ScreenUpdating = True
    MsgBox L - 1 & " files found!"
    Application.StatusBar = False
    'Reinitializes the display mode of the bar.
    Application.DisplayStatusBar = InitSB
    End Sub

    Private Function GetSubFolders(Path As String, Optional Start As Boolean) As Variant
    Dim Folder As Object, SubFolder As Object, D As Object
    Static TempArray() As String
    If Start Then
    ReDim TempArray(1 To 1)
    TempArray(1) = Path
    End If
    Set Folder = CreateObject("Scripting.FileSystemObject").GetFolder(Path)
    'Examine the current folder
    For Each D In Folder.subfolders
    ReDim Preserve TempArray(1 To UBound(TempArray) + 1)
    TempArray(UBound(TempArray)) = D.Path
    Next
    'Recursive processing of subfolders (based on code by F.Sigonneau)
    For Each SubFolder In Folder.subfolders
    GetSubFolders SubFolder.Path
    Next SubFolder
    GetSubFolders = TempArray()
    Set Folder = Nothing
    End Function

    Thank you in advance for your responses.
    0