N
Nils Morten
Hey guys
I have made a list of filenames of all files in a folder.
I manage this (by some help from my friends)
I have allocated some file attributes;
arFiles(0, cnt) = Folder.path
arFiles(1, cnt) = file.Name
arFiles(2, cnt) = Format(file.DateLastAccessed,
"yyyy.mm.dd hh:mm")
arFiles(3, cnt) = file.Size
and I really should complete the information with "file.owner" - but I
cant get through this...
Here is the essence of my macro-system:
'-----------------------------------------------------------------------
Sub Folders()
'-----------------------------------------------------------------------
On Error Resume Next
Sheets("All3DModel").Delete
If Err.Number <> 0 Then
On Error GoTo 0
End If
Dim Folder As String
Folder = 6
Folder = Trim(Folder)
Dim i As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
arFiles = Array()
cnt = 0
level = 1
ReDim arFiles(3, 0)
arFiles(0, 0) = Worksheets(1).Range("A" & Folder)
If arFiles(0, 0) <> "" Then
res = ThisWorkbook.Worksheets("Board").Range("A8").Value
res = Trim(res)
arFiles(1, 0) = level
SelectFiles arFiles(0, 0)
Worksheets.Add.Name = "All3DModel"
With ActiveSheet
.Cells(1, 1).Value = "Path"
.Cells(1, 2).Value = "FileName"
.Cells(1, 3).Value = "LastAccessed"
.Cells(1, 4).Value = "Size"
.Cells(1, 5).Value = "Owner" 'Header is ok, but my macro
will not generate the actual value
.Rows(1).Font.Bold = True
.Columns(4).NumberFormat = "#,##0 "" KB"""
cnt = 1
For i = LBound(arFiles, 2) To UBound(arFiles, 2)
.Cells(i + 2, 1).Value = arFiles(0, i)
.Cells(i + 2, 2).Value = arFiles(1, i)
.Cells(i + 2, 3).Value = arFiles(2, i)
.Cells(i + 2, 4).Value = arFiles(3, i) / 1024
' I think the "owner"-stuff should be placed somewhere like
this
ActiveSheet.Hyperlinks.Add Anchor:=.Cells(i + 2,
2), Address:=arFiles(0, i) & "\" & arFiles(1, i)
Next
.Columns("A").EntireColumn.AutoFit
End With
End If
End Sub
'-----------------------------------------------------------------------
Sub SelectFiles(ByVal sPath)
'-----------------------------------------------------------------------
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object
Set Folder = FSO.GetFolder(sPath)
Set Files = Folder.Files
For Each file In Files
If (file.Attributes And 2 Or file.Attributes And 4) Then
'
Else
If InStr(1, file.Name, res, vbTextCompare) > 0 Then
cnt = cnt + 1
ReDim Preserve arFiles(3, cnt)
arFiles(0, cnt) = Folder.path
arFiles(1, cnt) = file.Name
arFiles(2, cnt) = Format(file.DateLastAccessed,
"yyyy.mm.dd hh:mm")
arFiles(3, cnt) = file.Size
' I think the "owner"-stuff should be placed somewhere like
this too
End If
End If
Next file
level = level + 1
For Each fldr In Folder.Subfolders
SelectFiles fldr.path
Next
End Sub
'-------------------------------------------------------------
Function GetFolder(Optional ByVal _
Name As String = "Select a folder.") _
As String
'-------------------------------------------------------------
' I dont no if this have any significance to my problem
Dim bInfo As BROWSEINFO
Dim path As String
Dim oDialog As Long
bInfo.pidlRoot = 0&
bInfo.lpszTitle = Name
bInfo.ulFlags = &H1
oDialog = SHBrowseForFolder(bInfo)
path = Space$(512)
GetFolder = ""
If SHGetPathFromIDList(ByVal oDialog, ByVal path) Then
GetFolder = Left(path, InStr(path, Chr$(0)) - 1)
End If
End Function
I have made a list of filenames of all files in a folder.
I manage this (by some help from my friends)
I have allocated some file attributes;
arFiles(0, cnt) = Folder.path
arFiles(1, cnt) = file.Name
arFiles(2, cnt) = Format(file.DateLastAccessed,
"yyyy.mm.dd hh:mm")
arFiles(3, cnt) = file.Size
and I really should complete the information with "file.owner" - but I
cant get through this...
Here is the essence of my macro-system:
'-----------------------------------------------------------------------
Sub Folders()
'-----------------------------------------------------------------------
On Error Resume Next
Sheets("All3DModel").Delete
If Err.Number <> 0 Then
On Error GoTo 0
End If
Dim Folder As String
Folder = 6
Folder = Trim(Folder)
Dim i As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
arFiles = Array()
cnt = 0
level = 1
ReDim arFiles(3, 0)
arFiles(0, 0) = Worksheets(1).Range("A" & Folder)
If arFiles(0, 0) <> "" Then
res = ThisWorkbook.Worksheets("Board").Range("A8").Value
res = Trim(res)
arFiles(1, 0) = level
SelectFiles arFiles(0, 0)
Worksheets.Add.Name = "All3DModel"
With ActiveSheet
.Cells(1, 1).Value = "Path"
.Cells(1, 2).Value = "FileName"
.Cells(1, 3).Value = "LastAccessed"
.Cells(1, 4).Value = "Size"
.Cells(1, 5).Value = "Owner" 'Header is ok, but my macro
will not generate the actual value
.Rows(1).Font.Bold = True
.Columns(4).NumberFormat = "#,##0 "" KB"""
cnt = 1
For i = LBound(arFiles, 2) To UBound(arFiles, 2)
.Cells(i + 2, 1).Value = arFiles(0, i)
.Cells(i + 2, 2).Value = arFiles(1, i)
.Cells(i + 2, 3).Value = arFiles(2, i)
.Cells(i + 2, 4).Value = arFiles(3, i) / 1024
' I think the "owner"-stuff should be placed somewhere like
this
ActiveSheet.Hyperlinks.Add Anchor:=.Cells(i + 2,
2), Address:=arFiles(0, i) & "\" & arFiles(1, i)
Next
.Columns("A").EntireColumn.AutoFit
End With
End If
End Sub
'-----------------------------------------------------------------------
Sub SelectFiles(ByVal sPath)
'-----------------------------------------------------------------------
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object
Set Folder = FSO.GetFolder(sPath)
Set Files = Folder.Files
For Each file In Files
If (file.Attributes And 2 Or file.Attributes And 4) Then
'
Else
If InStr(1, file.Name, res, vbTextCompare) > 0 Then
cnt = cnt + 1
ReDim Preserve arFiles(3, cnt)
arFiles(0, cnt) = Folder.path
arFiles(1, cnt) = file.Name
arFiles(2, cnt) = Format(file.DateLastAccessed,
"yyyy.mm.dd hh:mm")
arFiles(3, cnt) = file.Size
' I think the "owner"-stuff should be placed somewhere like
this too
End If
End If
Next file
level = level + 1
For Each fldr In Folder.Subfolders
SelectFiles fldr.path
Next
End Sub
'-------------------------------------------------------------
Function GetFolder(Optional ByVal _
Name As String = "Select a folder.") _
As String
'-------------------------------------------------------------
' I dont no if this have any significance to my problem
Dim bInfo As BROWSEINFO
Dim path As String
Dim oDialog As Long
bInfo.pidlRoot = 0&
bInfo.lpszTitle = Name
bInfo.ulFlags = &H1
oDialog = SHBrowseForFolder(bInfo)
path = Space$(512)
GetFolder = ""
If SHGetPathFromIDList(ByVal oDialog, ByVal path) Then
GetFolder = Left(path, InStr(path, Chr$(0)) - 1)
End If
End Function