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