macro for listing content of directory

J

Jack Sons

Hi all,

I have the macro below the dotted line that I use to get an alphabetic list
with the content of a directory.
It works like a charm, but I want not only the names of the documents, but
also their date of last change. Preferably in 2 colums, like

ABCD.doc 13-3-2009
thisdocument.DOC 2-11-2004
thisisadocumentwithan
awfullylongname.doc 30-12-2008

etc.

I can't modify the code myself, Your help will be appreciated. I use Office
2k SP 2 with Word 2k.
Thanks in advance.

Jack Sons
The Netherlands
-----------------------------------------------------------------------------------------------------------
Sub Inhoud_Directory()

Dim PathWanted As String
Dim Temp As String
Dim i As Integer

With Dialogs(wdDialogFileOpen)
.Name = "*.*"
If .Display = -1 Then
'Documents.Add

PathWanted = Options.DefaultFilePath(wdDocumentsPath)
Set newdoc = Documents.Add
With newdoc
.Content.Font.Name = "Times New Roman"
.SaveAs FileName:=PathWanted
End With

Selection.TypeText "Files in " & PathWanted & ":" & vbCrLf
With Application.FileSearch
.LookIn = PathWanted
.FileName = "*.*"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Temp = .FoundFiles(i)
While InStr(Temp, "\") > 0
Temp = Mid(Temp, InStr(Temp, "\") + 1)
Wend
Selection.TypeText Temp & vbCrLf
Next
End If
End With
End If
End With
End Sub
 
G

Graham Mayor

If you want the name and date that appears in the Windows Explorer listing,
use the PrintFolders utility that you can download from my web site. It is
fast and configurable and not limited to folders containing documents.

If you want to read the properties from the documents themselves, you would
need to open the documents in order to read them. The following is based on
a basic batch process to open each document in a selected folder. It puts
the document name and save date in a two column borderless table in a new
document. The macro is inevitably slower than the former, but could be used
to read any of the document properties from this list (not all of which will
have content)
-
Title, Subject, Author, Keywords, Comments, Template, Last author, Revision
number, Application name, Last print date, Creation date, Last save time,
Total editing time, Number of pages, Number of words, Number of characters,
Security, Category, Format, Manager, Company, Number of bytes, Number of
lines, Number of paragraphs, Number of slides, Number of notes, Number of
hidden Slides, Number of multimedia clips, Hyperlink base, Number of
characters (with spaces), Content type, Content status, Language, Document
version

The macro reads the "Last Save Time" property

Sub GetNameAndSaveDate()
Dim strFileName As String
Dim strPath As String
Dim oDoc As Document
Dim NewDoc As Document
Dim ProDoc As DocumentProperty
Dim sDate As String
Dim Count As Long
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
Count = 0
With fDialog
.title = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , _
"List Folder Contents"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Right(strPath, 1) <> "\" _
Then strPath = strPath + "\"
End With
If Documents.Count > 0 Then
Documents.Close SaveChanges:=wdPromptToSaveChanges
End If
Set NewDoc = Documents.Add
NewDoc.Tables.Add NewDoc.Range, 1, 2
If Left(strPath, 1) = Chr(34) Then
strPath = Mid(strPath, 2, Len(strPath) - 2)
End If
strFileName = Dir$(strPath & "*.doc")

While Len(strFileName) <> 0
Set oDoc = Documents.Open(strPath & strFileName)
Count = Count + 1
For Each ProDoc In oDoc.BuiltInDocumentProperties
If ProDoc.name = "Last save time" Then
sDate = Format(ProDoc.Value, "dd/MM/yyyy")
Exit For
End If
Next ProDoc
With NewDoc.Tables(1)
.Cell(Count, 1).Range.Text = oDoc.name
.Cell(Count, 2).Range.Text = sDate
.Rows.Add
End With
oDoc.Close SaveChanges:=wdDoNotSaveChanges
strFileName = Dir$()
Wend
With NewDoc.Tables(1)
.Rows(Count + 1).Delete
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
End With
NewDoc.Content.Font.name = "Times New Roman"
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
 
P

Pesach Shelnitz

Hi Jack,

The FilesFound collection contains only the file names. You can't get the
dates from it. Thus, a simple modification of your macro doesn't seem
possible to me.

I therefore put together the following macro, which is based on some parts
of your macro, to do what you want.

Sub ListFilesAndDates()
Dim pathWanted As String
Dim newdoc As Document
Dim fso As Object
Dim fls As Object
Dim f As Object

With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then
pathWanted = .SelectedItems(1)
Else
MsgBox "You didn't select a folder."
Exit Sub
End If
End With
Set newdoc = Documents.Add
With newdoc
.Content.Font.name = "Times New Roman"
.SaveAs fileName:=pathWanted
End With
Selection.TypeText "Files in " & _
pathWanted & ":" & vbCrLf
Set fso = CreateObject("Scripting.FileSystemObject")
Set fls = fso.GetFolder(pathWanted).Files
For Each f In fls
Selection.TypeText f.name & vbTab _
& Format(f.DateLastModified, "d-m-yyyy") _
& vbCrLf
Next
Set newdoc = Nothing
Set fso = Nothing
Set fls = Nothing
Set f = Nothing
End Sub

If you want to change the format of the output, write back with more
details. Meanwhile, you can convert the output to a table by selecting it and
apply Convert To Table to it.
 
J

Jack Sons

Greg, Graham and Pesach, thanks for your help.

One very important question:

When I change anything (even the slightest change) in any macro in any of
the modules of Normal or when I add a new macro, next time I can't open
Word. Then I have to delete normal.dot and put in a copy of the normal.dot
as it was before I made a change. Very annoying and I have no idea what
causes this phenomenon. What causes this problem and how can I solve it
(once and for all)?

I am looking forward to your advice.

Jack.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top