Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Windows 2000 Pro - Exporting Search Results 1

Status
Not open for further replies.

Freckles

Technical User
May 1, 2000
138
US
For a number of reasons, I need to make a copy of the file names, directories, etc of the results of a search by date. Is there anyway to do this

::) Deb Koplen
deb.koplen@verizon.com
koplend@swbell.net (weekends and nights)

A person can stand almost anything except a succession of ordinary days.
 
I think you have to use a third-party utility.
Google "windows search utility"
 
You should be able to do this with some Excel VBA script.

Can you supply an example of a search?
 
Thanks


I am searching for all files that were last accessed before 12/31/2002



::) Deb Koplen
deb.koplen@verizon.com
koplend@swbell.net (weekends and nights)

A person can stand almost anything except a succession of ordinary days.
 
Yes, it is a BIG shared drive and I am responsible for all of it. I am going to give people a chance to clean up their own old files before I do it for them. And with this group, you have to be very specific.

::) Deb Koplen
deb.koplen@verizon.com
koplend@swbell.net (weekends and nights)

A person can stand almost anything except a succession of ordinary days.
 
Ok with that I'll post some code here, hopefully today if I can find 30 minutes between projects.
Otherwise I'll post it tonight unless of course someone else beats me to it.
 
Many Thanks [2thumbsup]

::) Deb Koplen
deb.koplen@verizon.com
koplend@swbell.net (weekends and nights)

A person can stand almost anything except a succession of ordinary days.
 
Give this a try...If it's close to what you need then I can polish it later if necessary.

For testing purposes the code is set to collect:
all files aka *.*
in C:not to include sub directories
with date last accessed before 12/31/03

I've bolded where you can make alterations
===========================================================


Sub TestListFilesInFolder()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~ Error handling (an example)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
On Error GoTo MyProcedure_Error
GoTo MyProcedure_Exit
MyProcedure_Error:
If Err.Number = 70 Then
'MsgBox ("Special handling for error #70 "& Err.Description)
Resume Next
Else
'MsgBox ("Special handling all other errors " & Err.Description)
Resume Next
End If
MyProcedure_Exit:
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~ Add Column Headers
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
With Range("A1")
.Formula = "Folder contents:"
.Font.Bold = True
.Font.Size = 12
End With
Range("A3").Formula = "File Name:"
Range("B3").Formula = "File Size:"
Range("C3").Formula = "File Type:"
Range("D3").Formula = "Date Created:"
Range("E3").Formula = "Date Last Accessed:"
Range("F3").Formula = "Date Last Modified:"
Range("G3").Formula = "Attributes:"
'had problems with this when empty
'Range("H3").Formula = "Short File Name:"
Range("A3:H3").Font.Bold = True

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~ Setup calling parameters
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Folder Name, File Type, Include Subfolders (T/F), Show MsgBox (T/F)
'Example ListFilesInFolder "l:\users\smills", ".pst", True, False
'Example ListFilesInFolder "c:\", "*.", True, False
ListFilesInFolder "c:\", "*.*", False, False

ActiveWorkbook.Save

MsgBox ("Done")
End Sub


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~ Main Subroutine
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub ListFilesInFolder(SourceFolderName As String, FileExtensions As String, IncludeSubfolders As Boolean, ShowMsgBox As Boolean)
Dim FSO
Dim SourceFolder, SubFolder
Dim FileItem
Dim Cutoff_Date As Date
Dim r As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~ determining the next avail row (one space between folders)
'~ you can run this macro many times with different criteria
'~ and it will add to the existing spreadsheet or you can
'~ delete all the rows and start new (remember the 65,536 row limit!)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
r = ActiveSheet.UsedRange.Rows.Count + 2
i = i + 1

Cutoff_Date = #12/31/2003#

For Each FileItem In SourceFolder.Files
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~ Choose specific file types OR choose all files
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If (StrComp(Right(UCase(FileItem), 4), UCase(FileExtensions), vbTextCompare) = 0) Or (StrComp(FileExtensions, "*.*", vbTextCompare) = 0) Then

If FileItem.DateLastAccessed < Cutoff_Date Then
Cells(r, 1).Formula = FileItem.Path '& FileItem.Name
Cells(r, 2).Formula = FileItem.Size
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~ Make &quot;Bold&quot; any filesizes larger than 1.5 gig or whatever
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If FileItem.Size > 1500000000 Then
Cells(r, 2).Font.Bold = True
End If
Cells(r, 3).Formula = FileItem.Type
Cells(r, 4).Formula = FileItem.DateCreated
Cells(r, 5).Formula = FileItem.DateLastAccessed
Cells(r, 6).Formula = FileItem.DateLastModified
Cells(r, 7).Formula = FileItem.Attributes
'Cells(r, 8).Formula = FileItem.ShortPath '& FileItem.ShortName
r = r + 1 ' next row number
End If
End If
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, FileExtensions, True, False
Next SubFolder
End If
Columns(&quot;C:H&quot;).AutoFit
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub



 
I should have explained the Attributes:

The newattributes argument can have any of the following values or any logical combination of the following values:

Constant Value Description
Normal 0 Normal file. No attributes are set.
ReadOnly 1 Read-only file. Attribute is read/write.
Hidden 2 Hidden file. Attribute is read/write.
System 4 System file. Attribute is read/write.
Volume 8 Disk drive volume label. Attribute is read-only.
Directory 16 Folder or directory. Attribute is read-only.
Archive 32 File has changed since last backup. Attribute is read/write.
Alias 64 Link or shortcut. Attribute is read-only.
Compressed 128 Compressed file. Attribute is read-only.
 
I am sorry that I have not got back to you, nor tested your solution, but I have been down with the crud and am posting this from home. As soon as I get back to the office, I will test your solution and probably come back with more questions.



::) Deb Koplen
deb.koplen@verizon.com
koplend@swbell.net (weekends and nights)

A person can stand almost anything except a succession of ordinary days.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top