View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Gary Brown[_5_] Gary Brown[_5_] is offline
external usenet poster
 
Posts: 236
Default File Size Code not working

Without using a reference to FSO, you can revise this code. The reference
may be goofing things up.

'/===============================================/
Sub GetMyFileNames()
Dim i As Long, y As Long
Dim r As Long
Dim strFileName As String
Dim strPath As String
Dim strExtension As String

r = 1
With Application.FileSearch
.NewSearch
.LookIn = ActiveWorkbook.Path & "\"
.Filename = "*.xls"
.SearchSubFolders = True
.Execute
For i = 1 To .FoundFiles.Count
strFileName = ""
strPath = ""
For y = Len(.FoundFiles(i)) To 1 Step -1
If Mid(.FoundFiles(i), y, 1) = "\" Then
Exit For
End If
strFileName = _
Mid(.FoundFiles(i), y, 1) & strFileName
Next y
strPath = Left(.FoundFiles(i), _
Len(.FoundFiles(i)) - Len(strFileName))
strExtension = ""
For y = Len(strFileName) To 1 Step -1
If Mid(strFileName, y, 1) = "." Then
If Len(strFileName) - y < 0 Then
strExtension = Right(strFileName, _
Len(strFileName) - y)
strFileName = Left(strFileName, y - 1)
Exit For
End If
End If
Next y
Cells(r, 1) = .FoundFiles(i)
ActiveSheet.Hyperlinks.Add _
Anchor:=Cells(r, 1), Address:=.FoundFiles(i)
Cells(r, 2) = strPath
Cells(r, 3) = strFileName
Cells(r, 4) = strExtension
Cells(r, 5) = FileLen(.FoundFiles(i))
Cells(r, 6) = FileDateTime(.FoundFiles(i))
r = r + 1
Next i
End With

'formatting
Rows("1:1").Insert Shift:=xlDown
Range("A1").FormulaR1C1 = "Hyperlink"
Range("B1").FormulaR1C1 = "Path"
Range("C1").FormulaR1C1 = "Filename"
Range("D1").FormulaR1C1 = "File Ext"
Range("E1").FormulaR1C1 = "Size"
Range("F1").FormulaR1C1 = "Date"
Columns("A:F").EntireColumn.AutoFit
Range("A2").Select
ActiveWindow.FreezePanes = True
ActiveWindow.Zoom = 75

End Sub
'/===============================================/

HTH,
Gary Brown


"briank" wrote:

A few weeks back I posted a question about getting code to list file sizes in
a worksheet upon startup. A response was posted and even worked a few times
but since then I have not been able to keep this code working. For what it is
worth, the code is in a worksheet called StartUp and ideally I want the files
to started populating at cell A1. Any assistance on what I am doing
incorrectly would be appreciated.

Sub Workbook_Open(dir_test)
Dim fs, f, s
Dim filespec As String
Dim count As Integer
count = 1
Set fs = CreateObject("Scripting.FileSystemObject")
filespec = Dir(ActiveWorkbook.Path & "\*.xls")
Do While filespec < ""
Set f = fs.GetFile(filespec)
s = f.Size
n = f.Name
Range("A" & count) = n
Range("B" & count) = s & " KB"
filespec = Dir
count = count + 1
Loop
End Sub