Spreadsheet Ability?

Posted by: Dignan

Spreadsheet Ability? - 22/09/2003 00:22

Can Excell or really any spreadsheet program do the following:

Can a spreadsheet go out and find a specific property of a file and store it in a cell? For instance, look for the storage size if a folder?
Posted by: siberia37

Re: Spreadsheet Ability? - 22/09/2003 07:20

You might be able to do this using Visual Basic macros. In fact I'm sure you could do this using VB Macros- don't ask me how to do it though I'm a Delphi programmer.
Posted by: Mach

Re: Spreadsheet Ability? - 22/09/2003 07:34

From a Deja Troll

' CreateXLAllFolderList
' Version 1.0 Stuart W Moore 23rd July 2002
'Adapted from Script in g:\vb5\scripting
'Needs Reference to Microsoft Scripting Runtime c:\winnt\system32\scrrun.dll
' *** ************************************** OR c:\windows\system\scrrun.dll
'This script will prompt for a folder path and create an Excel worksheet
'containing the file details. This version will look at the top level
'folder and all subfolders.
Dim fso As FileSystemObject, objXL As Application
Dim Message_Txt As String, Title_Txt As String
Dim filename As String, folderspec As String
Dim result As Boolean
Dim irow As Long, l As Integer
Dim ff As Files

Sub AllFilesList()
Call Welcome
folderspec = InputBox("Enter a pathname to return a list of files: ", _
Title_Txt)
If IsEmpty(folderspec) Then
Exit Sub
End If

Set fso = New FileSystemObject
If Not fso.FolderExists(folderspec) Then
MsgBox "No such Folder as '" & folderspec & "'!", vbOKOnly + vbExclamation, Title_Txt
Exit Sub
End If

Set objXL = Application
objXL.Workbooks.Add
objXL.Visible = True
objXL.DisplayAlerts = False
Do Until ActiveWorkbook.Sheets.Count = 1
ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count).Delete
Loop
objXL.DisplayAlerts = True
objXL.Cells(2, 1).Value = "Parent Folder"
objXL.Cells(2, 2).Value = "Filename"
objXL.Cells(2, 3).Value = "Size, KB"
objXL.Cells(2, 4).Value = "Type"
objXL.Cells(2, 5).Value = "Created"
objXL.Cells(2, 6).Value = "Last Accessed"
objXL.Cells(2, 7).Value = "Last Modified"
objXL.Rows(2).Select
objXL.Selection.Font.Bold = True
objXL.Range("A:B").ColumnWidth = 30
objXL.Range("C:C").ColumnWidth = 10
objXL.Range("D:D").ColumnWidth = 30
objXL.Range("E:G").ColumnWidth = 15
objXL.Columns(2).Select
objXL.Selection.NumberFormat = "@"
objXL.Columns(3).Select
objXL.Selection.Cells.NumberFormat = "0.0"
objXL.Range("A1").Select
objXL.StatusBar = "Working, please wait...."
irow = 2
If Right(folderspec, 1) = "\" Then
l = Len(folderspec) + 1
Else
l = Len(folderspec) + 2
End If

result = CreateXLFolderList(folderspec)

'Now sort out the Worksheet
objXL.Cells.Select
objXL.Selection.Columns.AutoFit
objXL.Selection.AutoFilter
objXL.Cells(1, 1).Select
objXL.Cells(1, 1).Value = "List of all " & (irow - 2) & " files in " & folderspec & " at " & Time & " on " & Date
objXL.Rows(1).Select
objXL.Selection.Font.Bold = True
objXL.Selection.Font.Size = 14
objXL.Cells(3, 1).Select
objXL.ActiveWindow.FreezePanes = True
objXL.StatusBar = False
'Tidy up
Set objXL = Nothing
Set ff = Nothing
Set fso = Nothing
End Sub

Sub Welcome()
Message_Txt = "This script will create an Excel worksheet" & vbCrLf & _
"containing details of all the files in the " & vbCrLf & _
"specified folder and its subfolders (if any)"
Title_Txt = "CreateXLAllFolderList V1.0 SWM 23/07/2002"
Dim intDoIt
intDoIt = MsgBox(Message_Txt, vbOKCancel + vbInformation, Title_Txt)
If intDoIt = vbCancel Then
End
End If
End Sub

Private Function CreateXLFolderList(fspec)
Dim f As Folder, f1 As File, fc As Files, s As Folder, sPart As String
Set f = fso.getfolder(fspec)
On Error Resume Next
If f.Files.Count <> 0 Then
Set fc = f.Files
For Each f1 In fc
irow = irow + 1
objXL.StatusBar = "Working....." & irow - 2 & " files found"
'Exclude from the listed pathname the spec originally entered
sPart = Mid(f1.Path, l)
'Knock off the filename part
sPart = Left(sPart, Len(sPart) - Len(f1.Name))
objXL.Cells(irow, 1).Value = sPart
objXL.Cells(irow, 2).Value = f1.Name
objXL.Cells(irow, 3).Value = f1.Size / 1024
objXL.Cells(irow, 4).Value = f1.Type
objXL.Cells(irow, 5).Value = f1.DateCreated
objXL.Cells(irow, 6).Value = f1.DateLastAccessed
objXL.Cells(irow, 7).Value = f1.DateLastModified
Next
End If
'This is the recursive bit
If f.subfolders.Count > 0 Then
For Each s In f.subfolders
CreateXLFolderList (s)
Next
End If

CreateXLFolderList = True
End Function