A bit more...


Option Explicit

Sub FileInformation()

'File information Macro
'The Macro Lists the files & file properties in a directory and it
subdirectories and writes
'it into a tab delimited text file (predefined c:\1\kismalac.txt)
' needs reference to "DS: OLE Document Properties 1.2 Object Library
or higher

Dim asdf As String ' activeworkbook

' file properties:
Dim FileName As String ' name of the file
Dim fileinfo As String ' file properties info
Dim FileSpec As String ' file name
Dim fileDatCr As Date 'DateCreated
Dim fileLastAc As Date 'DateLastAccessed
Dim fileLastMod As Date 'DateLastModified
Dim fileSiz As Double 'Size
Dim fileTyp As String 'Type
Dim filePat As String 'Path


'objects
Dim szorcs As Object 'search file
Dim fso As Object ' file sys object
Dim fs, f As Object ' to access text files
Dim DSO As DSOleFile.PropertyReader ' needs reference to "DS: OL
Document Properties 1.2 Object Library"
Set DSO = New DSOleFile.PropertyReader

'other
Dim i As Long ' from ... to
Dim mainFold As String ' main folder
Dim applicName As String

mainFold = InputBox("Please input the target folder path"
"FileProperties")
Application.ScreenUpdating = False
asdf = ActiveWorkbook.Name
applicName = Application.Caption

Set szorcs = Application.FileSearch
'On Error GoTo hiba

With szorcs
.LookIn = mainFold
.SearchSubFolders = True
.FileName = "*.*"
If .Execute() 0 Then
Application.ScreenUpdating = False
Application.Caption = "There were " & .FoundFiles.Count & _
" file(s) found."

Application.ScreenUpdating = False

For i = 1 To .FoundFiles.Count
FileName = .FoundFiles(i)

'----------------------------------------------------------------
'write routine
'----------------------------------------------------------------


Set fso = CreateObject("Scripting.FileSystemObject")

' get file info


fileLastAc = fso.GetFile(FileName).DateLastAccessed
FileSpec = fso.GetFileName(FileName)
fileDatCr = fso.GetFile(FileName).DateCreated
fileLastMod = fso.GetFile(FileName).DateLastModified
fileSiz = fso.GetFile(FileName).Size
fileTyp = fso.GetFile(FileName).Type
filePat = fso.GetFile(FileName).Path

On Error Resume Next

' define info needed

fileinfo = FileSpec & vbTab & fileDatCr & vbTab
fileLastAc & vbTab & fileLastMod & vbTab & _
fileSiz & vbTab & fileTyp & vbTab & filePat

' insert info to text file

'Const ForReading = 1, ForWriting = 2, ForAppending
8

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("c:\1\kismalac.txt", 8) '
True, TristateFalse)
f.Write vbCrLf & fileinfo
f.Close



'--------------------------------------------------------------------
' end of write routine

'--------------------------------------------------------------------



Next i
Else
MsgBox "There were no files found."
End If


End With
GoTo vege

hiba:

fileinfo = MsgBox("Something went wrong.....", vbOKOnly)


vege:

Workbooks(asdf).Activate
Application.ScreenUpdating = True

End Su

--
speidlbacs
-----------------------------------------------------------------------
speidlbacsi's Profile: http://www.excelforum.com/member.php...nfo&userid=252
View this thread: http://www.excelforum.com/showthread.php?threadid=31887