Advertisement
Advertisement
| 08.22.2008 at 10:10AM PDT, ID: 23670904 |
|
[x]
Attachment Details
|
||
|
[x]
The Solution Rating System
|
||
With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.
Your Input Matters If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support. Thank you! |
||
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: |
Sub GetFolderInfo()
Dim myArr(0 To 500) As String, i As Long, j As Integer, fl, k As Integer, strType As String
Dim sFld
For i = 2 To Range("A65536").End(xlUp).Row
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(Cells(i, 1))
Cells(i, 5) = CLng(fld.Size / 1048576 * 100) / 100
Cells(i, 3) = fld.subfolders.Count
Cells(i, 2) = fld.Files.Count
j = 0
For Each fl In fld.Files
If j = 0 Then GoTo nxt1
For k = 0 To j
If Right(fl.Name, 3) = myArr(k) Then GoTo nxt2
Next k
nxt1:
myArr(j) = Right(fl, 3)
j = j + 1
nxt2:
Next
For Each sFld In fld.subfolders
Cells(i, 2) = Cells(i, 2) + sFld.Files.Count
For Each fl In sFld.Files
If j = 0 Then GoTo nxt3
For k = 0 To j
If Right(fl.Name, 3) = myArr(k) Then GoTo nxt4
Next k
nxt3:
myArr(j) = Right(fl, 3)
j = j + 1
nxt4:
Next fl
Next sFld
For k = 0 To j
strType = strType & myArr(k) & ","
Next k
Cells(i, 4) = Left(strType, Len(strType) - 1)
Set sf = Nothing
Set fld = Nothing
Set sFld = Nothing
Set fso = Nothing
Next
End Sub
|