Solved: Import File Name and Date Modified

[spartacus132]

Hi All,
I am trying to achieve the following:
1. Specify a directory
2. Import the file names (including file extension) of all files in the specified directory into column A.
3. Extract the dates modified information from each file and place it in the adjacent row (in column B).
4. If the ?Date Modified? value is greater than 9/1/2006 then place a yes in the adjacent row (in column C).

Any help is appreciated.

Thanks!

Ps- i am attaching a workbook for sample layout info.

[mvidas]

Hi spartacus,

Sub NiceAvatar()
Dim vFile As String, vPath As String, R As Long
vPath = "C:\folder name\" 'we can have this as an inputbox or folder-picker dialog
R = 3 'first row to put data into
If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
vFile = Dir(vPath, 7) '7=all attributes
Do Until Len(vFile) = 0
Cells(R, 1) = vFile
Cells(R, 2) = FileDateTime(vPath & vFile)
Cells(R, 3) = IIf(Cells(R, 2).Value > #9/1/2006#, "Yes", "No")
R = R + 1
vFile = Dir
Loop
End Sub

If you'd like any additions made or anything, don't hesitate to ask!
Matt

[spartacus132]

Matt,
Thanks for the excellent reply time--I wasn't expecting such a short amount of code, it was a surprise. :bow: Matt, would it be possible to alter the code so that the code is able to go to a specified directory and probe all subdirectories as well as files in the directory itself for the exact same information that was captured in the original request.

[mvidas]

It is absolutely possible (though will be a bit longer, code-wise :))
Do you want column A to just contain "filename.ext" or do you want the subdirectories too (ie "subfolder1\filename.ext") ?
Do you want to be asked for the folder at runtime? If so, would you like just an input box or an actual folder-picker?
I will take a bit longer getting the next step to you, as time is a little tight for me at the moment. Shouldnt be too long though

[spartacus132]

Matt,
If time is a constraint for you right now, delay this for as long as you wish--I am not in a rush. Matt, actually the true format that I require is to have the listing that will be created with your original code, and then I would like to be able to probe another directory to obtain the same information—however, this time I need to include all files (i.e-"filename.ext") in the directory as well as any subdirectories. Therefore, this additional request of mine will populate column D,E and F in the sheet. A,B,C are populated with the code that you have already provided.

Another difference will be that this time the the “Date modified” value will not be compared against 9\1\2006, but rather the values in column C if the report names match.

Let me know if you need additional information, you don’t have to produce all of the above, if I can have the skeleton, I can try my best to build upon that.

I am attaching a sample layout to help you understand better

[mdmackillop]

Have a look in the KB for some ideas, try a search for "subfolder"
Regards
MD

[mvidas]

spartacus,

Try the following. The directory (no subfolders currently being checked, goes to columns A:C) should go into vPath1 and the second directory (with subfolders, entered into D:F) should go into vPath2Sub NiceAvatar()
Dim vPath1 As String, vPath2 As String, R As Long, vFiles() As String
Dim i As Long, FND As Range

vPath1 = "C:\folder name\"
vPath2 = "C:\foldername\"

'Get your initial path
If Right(vPath1, 1) <> "\" Then vPath1 = vPath1 & "\"
R = 3 'first row to put data into
ReDim vFiles(1, 0)
ReturnAllFilesUsingDir vPath1, vFiles, IncludeSubfolders:=False
If Len(vFiles(0, 0)) > 0 Then
For i = 0 To UBound(vFiles, 2)
Cells(R, 1) = vFiles(1, i)
Cells(R, 2) = FileDateTime(vFiles(0, i) & vFiles(1, i))
Cells(R, 3) = IIf(Cells(R, 2).Value > #9/1/2006#, "Yes", "No")
R = R + 1
Next
End If

'Get your second path
If Right(vPath2, 1) <> "\" Then vPath2 = vPath2 & "\"
R = 3 'first row to put data into
ReDim vFiles(1, 0)
ReturnAllFilesUsingDir vPath2, vFiles, IncludeSubfolders:=True '**
If Len(vFiles(0, 0)) > 0 Then
For i = 0 To UBound(vFiles, 2)
Cells(R, 4) = vFiles(1, i)
Cells(R, 5) = FileDateTime(vFiles(0, i) & vFiles(1, i))
Set FND = Columns(1).Find(vFiles(1, i), LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=False)
If Not FND Is Nothing Then
Cells(R, 6) = IIf(Cells(R, 5).Value > FND.Offset(0, 1), "Yes", "No")
End If
R = R + 1
Next
End If

End Sub
Function ReturnAllFilesUsingDir(ByVal vPath As String, ByRef vsArray() _
As String, Optional IncludeSubfolders As Boolean = True) As Boolean
Dim tempStr As String, vDirs() As String, Cnt As Long, dirCnt As Long
dirCnt = 0
If Len(vsArray(0, 0)) = 0 Then
Cnt = 0
Else
Cnt = UBound(vsArray, 2) + 1
End If
If Right(vPath, 1) <> "\" Then vPath = vPath & "\"

If IncludeSubfolders Then
On Error GoTo BadDir
tempStr = Dir(vPath, 31)
Do Until Len(tempStr) = 0
If Asc(tempStr) <> 46 Then
If GetAttr(vPath & tempStr) And vbDirectory Then
ReDim Preserve vDirs(dirCnt)
vDirs(dirCnt) = tempStr
dirCnt = dirCnt + 1
End If
BadDirGo:
End If
tempStr = Dir
SkipDir:
Loop
End If

On Error GoTo BadFile
tempStr = Dir(vPath, 15)
Do Until Len(tempStr) = 0
ReDim Preserve vsArray(1, Cnt)
vsArray(0, Cnt) = vPath
vsArray(1, Cnt) = tempStr
Cnt = Cnt + 1
tempStr = Dir
Loop
BadFileGo:
On Error GoTo 0
If dirCnt > 0 Then
For dirCnt = 0 To UBound(vDirs)
If Len(Dir(vPath & vDirs(dirCnt))) = 0 Then
ReturnAllFilesUsingDir vPath & vDirs(dirCnt), vsArray
End If
Next
End If
Exit Function
BadDir:
If tempStr = "pagefile.sys" Or tempStr = "???" Then
' Debug.Print "DIR: Skipping: " & vPath & tempStr
Resume BadDirGo
ElseIf Err.Number = 52 Then
' Debug.Print "No read dir rights: " & vPath & tempStr
Resume SkipDir
End If
Debug.Print "Error with DIR Dir: " & Err.Number & " - " & Err.Description
Exit Function
BadFile:
If Err.Number = 52 Then
' Debug.Print "No read file rights: " & vPath & tempStr
Else
Debug.Print "Error with DIR File: " & Err.Number & " - " & Err.Description
End If
Resume BadFileGo
End Function
Matt

[spartacus132]

I can no other answer make, but, thanks, and thanks. ~William Shakespeare

Matt: Thanks so much for your help on this matter, excellent solution.
Cheers,
Brandon

[mvidas]

Glad to help! Please don't hesitate to ask if you have any more questions :)

Also, as you're new-ish to VBAX, when an issue is completed, you can go to "Thread Tools" at the top of the thread and choose "Mark Thread Solved". This prepends the subject with the text "Solved: " so others know you're all set.