Hey guys,
I currently have two related problems when running a macro, hopefully someone that is more experienced than me can figure this out:
Purpose of the macro: read all files within a folder (and subfolders), list various file attributes ofeach file (file size, author etc.) on a worksheet.
I have pasted the entire code (removed some irrelevant code to improve readability), but really the problem occurs with the section in red.
First problem: I have no idea why but instead of getdetailsof(.Items.Item(x), 148) I have to use "x-1" otherwise there is a mismatch between the file and its attributes. Does the first item start from number 0?
Second problem: As opposed to the first issue which is fixable, I realised there is an overall mismatch between file and file attributes, because the dir reads "thumb.db" which is a hidden system file (see example 1 below), I tried to exclude this particular file by using dir(targetfiles,vbnormal), however there is still a mismatch.
example 1:
File 1 (JPEG) JPEG
FIle 2 (TXT) TXT
results
File 1 (JPEG) JPEG
thumb.db TXT
File 2 (TXT) folder type
with dir (, hidden)
results
File 1 (JPEG) JPEG
File 2 (TXT) folder type
p.s. Is there any other way which I can read these file attributes? While running the code, I can see from the local window that the correct file attribute is listed under startingfolder.files.items(1) etc, but I cant figure out the correct syntax to retrieve it.
Sorry if I have not done a very good job at explaining my problem, please let me know if you need further information.
thanks in advance
I currently have two related problems when running a macro, hopefully someone that is more experienced than me can figure this out:
Purpose of the macro: read all files within a folder (and subfolders), list various file attributes ofeach file (file size, author etc.) on a worksheet.
Rich (BB code):
'Option Explicit
Public FSO As New FileSystemObject
Private FileType As Variant
Sub ListHyperlinkFilesInSubFolders()
Dim startingcell As Range 'Cell where hyperlinked list starts
Dim FSOFolder As Folder
Dim RootFolder As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Ask for folder to list files from
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select folder to list files from"
.Show
'If a folder has been selected
If .SelectedItems.Count <> 0 Then
RootFolder = .SelectedItems(1)
Set FSOFolder = FSO.GetFolder(RootFolder)
'Ask what type of files to look for
FileType = Application.InputBox("* and ? wildcards are valid " & vbCrLf & vbCrLf & " e.g. .xls* to list XLS, XLSX and XLSM" _
& vbCrLf & vbCrLf & "??st.* to list West.xlsx and East.xlsx" & vbCrLf & vbCrLf & "Just click OK to list all files.", _
"What type of files do you want to list?", "")
If FileType = False Then 'Cancel pressed
MsgBox "Process Cancelled"
Exit Sub
ElseIf FileType = vbNullString Then 'Nothing entered and OK pressed
FileType = "*.*"
End If
'Clear the active sheet to remove previous results
'ActiveSheet.Cells.Clear
'Enter default message in case no files are in folder
'With Range(StartingCell)
'.ClearFormats
'.Value = "No " & FileType & " files found in " & RootFolder
'.Select
'End With
' Call recursive sub to list files
ListFilesInSubFolders FSOFolder
'Autofit the columns containing our results
Columns.AutoFit
Else
'If no folder selected, admonish user for wasting CPU cycles :)
MsgBox "No folder selected.", vbExclamation
End If
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Sheet2.Range ("A1 activate")
End Sub
Sub ListFilesInSubFolders(StartingFolder As Scripting.Folder)
Dim CurrentFilename As String
Dim OffsetRow As Long
Dim TargetFiles As String
Dim SubFolder As Scripting.Folder
Dim foldername As String
Dim startingcell As Range
Dim endcell As Range
Dim cell As Variant
Dim firstrow As Integer
Dim lastrow As Integer
Dim x As Variant
Dim Modcol As Integer, Linkcol As Integer, Datecol As Integer, Foldernamecol As Integer, OPcol As Integer
Dim Typecol As Integer, Authorcol As Integer, Titlecol As Integer, Subjcol As Integer
Dim CCcol As Integer, FROMcol As Integer, TOcol As Integer
Sheet2.Activate
'Write name of folder to cell
foldername = StartingFolder.Path
'get starting row
Set startingcell = Sheets(2).Range("A99999").End(xlUp).Offset(1)
' find firstrow
firstrow = startingcell.Row
'find out where to insert info - find the correct columns
Modcol = Sheet2.Cells(1, 1).EntireRow.find(What:="Last date modified", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
Foldernamecol = Sheet2.Cells(1, 1).EntireRow.find(What:="Folder name", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
Linkcol = Sheet2.Cells(1, 1).EntireRow.find(What:="hyperlink", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
Datecol = Sheet2.Cells(1, 1).EntireRow.find(What:="Date added", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
'OPcol = Sheet2.Cells(1, 1).EntireRow.Find(What:="operator", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
Typecol = Sheet2.Cells(1, 1).EntireRow.find(What:="File Type", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
Authorcol = Sheet2.Cells(1, 1).EntireRow.find(What:="Author of Document", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
Titlecol = Sheet2.Cells(1, 1).EntireRow.find(What:="Document Title", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
Subjcol = Sheet2.Cells(1, 1).EntireRow.find(What:="Subject of Email", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
CCcol = Sheet2.Cells(1, 1).EntireRow.find(What:="Email CC", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
FROMcol = Sheet2.Cells(1, 1).EntireRow.find(What:="Email Sender", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
TOcol = Sheet2.Cells(1, 1).EntireRow.find(What:="Email Recipient", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
'Createcol = Sheet2.Cells(1, 1).EntireRow.find(What:="Date Created", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
PageCol = Sheet2.Cells(1, 1).EntireRow.find(What:="Number of Pages", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
SlideCol = Sheet2.Cells(1, 1).EntireRow.find(What:="Number of Slides", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
'Get the first file, look for Normal, Read Only, System and Hidden files
TargetFiles = StartingFolder.Path & "\" & FileType
CurrentFilename = Dir(TargetFiles,7)
OffsetRow = 0
x = 1
Do While CurrentFilename <> ""
'Create the hyperlink
' need to find where the corresponding heading is
startingcell.Offset(OffsetRow, Linkcol - 1).Hyperlinks.Add Anchor:=startingcell.Offset(OffsetRow, 2), Address:=StartingFolder.Path & "\" & CurrentFilename, TextToDisplay:=CurrentFilename
startingcell.Offset(OffsetRow, Foldernamecol - 1) = foldername
startingcell.Offset(OffsetRow, Modcol - 1) = FileDateTime(foldername + "\" + CurrentFilename)
startingcell.Offset(OffsetRow, Datecol - 1) = Format(Date, "YYYY / mm / dd")
With CreateObject("shell.application").Namespace(foldername & "\")
startingcell.Offset(OffsetRow, Typecol - 1) = .getdetailsof(.Items.Item(x - 1), 2)
startingcell.Offset(OffsetRow, FROMcol - 1) = .getdetailsof(.Items.Item(x - 1), 207)
startingcell.Offset(OffsetRow, TOcol - 1) = .getdetailsof(.Items.Item(x - 1), 213)
startingcell.Offset(OffsetRow, Subjcol - 1) = .getdetailsof(.Items.Item(x - 1), 22)
startingcell.Offset(OffsetRow, CCcol - 1) = .getdetailsof(.Items.Item(x - 1), 202)
startingcell.Offset(OffsetRow, Authorcol - 1) = .getdetailsof(.Items.Item(x - 1), 20)
startingcell.Offset(OffsetRow, PageCol - 1) = .getdetailsof(.Items.Item(x - 1), 148)
startingcell.Offset(OffsetRow, SlideCol - 1) = .getdetailsof(.Items.Item(x - 1), 149)
End With
OffsetRow = OffsetRow + 1
x = x + 1
'Get the next file
CurrentFilename = Dir
Loop
' Offset the DestinationRange one column to the right and OffsetRows down so that we start listing files
' inthe next folder below where we just finished. This results in an indented view of the folder structure
Set startingcell = startingcell.Offset(OffsetRow)
' For each SubFolder in the current StartingFolder call ListFilesInSubFolders (recursive)
' The sub continues to call itself for each and every folder it finds until it has
' traversed all folders below the original StartingFolder
For Each SubFolder In StartingFolder.SubFolders
ListFilesInSubFolders SubFolder
Next SubFolder
lastrow = Sheets(2).Range("A99999").End(xlUp).Row
With Range(Cells(firstrow, 1), Cells(lastrow, 19))
.Borders.LineStyle = xlNone
For Each cell In Array(xlEdgeTop, xlInsideHorizontal, xlEdgeBottom, xlLeft, xlRight)
With .Borders(cell)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Next cell
End With
End Sub
I have pasted the entire code (removed some irrelevant code to improve readability), but really the problem occurs with the section in red.
First problem: I have no idea why but instead of getdetailsof(.Items.Item(x), 148) I have to use "x-1" otherwise there is a mismatch between the file and its attributes. Does the first item start from number 0?
Second problem: As opposed to the first issue which is fixable, I realised there is an overall mismatch between file and file attributes, because the dir reads "thumb.db" which is a hidden system file (see example 1 below), I tried to exclude this particular file by using dir(targetfiles,vbnormal), however there is still a mismatch.
example 1:
File 1 (JPEG) JPEG
FIle 2 (TXT) TXT
results
File 1 (JPEG) JPEG
thumb.db TXT
File 2 (TXT) folder type
with dir (, hidden)
results
File 1 (JPEG) JPEG
File 2 (TXT) folder type
p.s. Is there any other way which I can read these file attributes? While running the code, I can see from the local window that the correct file attribute is listed under startingfolder.files.items(1) etc, but I cant figure out the correct syntax to retrieve it.
Sorry if I have not done a very good job at explaining my problem, please let me know if you need further information.
thanks in advance