Hi,

Here is a function that will do basically what you want...

Sub alldocs(whatdir)
Dim allinfo As String
Dim curdocinfo As String
Dim curver As Integer
Dim mytemplate As Template

Dim f1 As String

If Right(whatdir, 1) <> Application.PathSeparator Then
   whatdir = whatdir & Application.PathSeparator
End If

f1 = Dir(whatdir & "*.doc")
Do While f1 <> ""
    curdocinfo = ""
    Documents.Open FileName:=whatdir & f1
    curdocinfo = "Document - " & f1 & " is in folder - " & whatdir & vbCrLf
    curver = ActiveDocument.Versions.Count
    curdocinfo = curdocinfo & "Current Version Saved By - " &
ActiveDocument.Versions(curver).SavedBy & vbCrLf
    curdocinfo = curdocinfo & "Date Last Saved - " & FileDateTime(whatdir &
f1) & vbCrLf
    curdocinfo = curdocinfo & "Created By - " &
ActiveDocument.Versions(1).SavedBy & vbCrLf
   
    curdocinfo = curdocinfo & "Title - " &
ActiveDocument.BuiltInDocumentProperties(wdPropertyTitle) & vbCrLf
    curdocinfo = curdocinfo & "Template - " &
ActiveDocument.BuiltInDocumentProperties(wdPropertyTemplate) & vbCrLf & vbCrLf
    allinfo = allinfo & curdocinfo
    ActiveDocument.Close savechanges:=False
   
   f1 = Dir
Loop

Selection.HomeKey unit:=wdStory
Selection.InsertBefore allinfo

End Sub

invoke this with
alldocs("k:\dept25\alldocs")

Note:
you want to add error checking (on error...) and probably want to freeze the
screen while this is going on (lots of flashing as files are opened and
closed).
If a document was not saved as a version errors will be raised when this
code is run so add error checking...
This will check all the docs in the passed folder not subfolders of the
passed folder.

Old Man