hmm..need help with this one..a GURU needed for this one.

Suzanne - I found a macro on another site that, cobbled with another, may do what you need.

'created using John Walkenbach's "Microsoft Excel 2000 Power
' Programming with VBA" example as a basic starting point
'======================================================
'32-bit API declarations
Option Explicit
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
As Long

'======================================================
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'======================================================

Public Sub ListFilesToWorksheet()
On Error GoTo Err_ListFiles:
'History:
' 07/15/2000 added hyperlink
' 07/17/2000 added filename filter
' 07/20/2000 added # files found info & criteria info
' 07/27/2000 added extension as separate column
' 08/03/2000 changed # files found to 'count' formula
' 10/23/2000 add status bar 'Wait' message
' 10/31/2000 simplified by Jim Cone
Dim blnSubFolders As Boolean
Dim LastRow As Long
Dim i As Integer, r As Integer, N As Integer, Y As Integer
Dim msg As String, Directory As String, strPath As String
Dim strFileName As String
Dim strFileNameFilter As String, strDefaultMatch As String
Dim strExtension As String, strFileBoxDesc As String
Dim varSubFolders As Variant, WS As Worksheet

'/==========Variables=============
strDefaultMatch = "*.*"
r = 1
i = 1
blnSubFolders = False
'/==========Variables=============

strFileNameFilter = "*.DOC"
'strFileNameFilter = InputBox("Examples:" & vbCr & _
" *.* will find all files" & vbCr & _
" *.xls will find all Excel files" & vbCr & _
" blank will find all Office files" & vbCr & _
" G*.doc will find all Word files beginning with G" & vbCr & _
" Test.txt will find only the files named TEST.TXT" & vbCr, _
"Enter file name to match:", Default:=strDefaultMatch)

'If Len(strFileNameFilter) = 0 Then
'strFileBoxDesc = "All MSOffice files"
'Else
'strFileBoxDesc = strFileNameFilter
'End If
msg = " Look for: " & strFileBoxDesc & vbCr & _
" Select location of files or press Cancel."
Directory = GetDirectory(msg)
If Directory = "" Then Exit Sub
If Right(Directory, 1) = "^#92;" Then Directory = Directory & "^#92;"

varSubFolders = _
MsgBox("Search Sub-Folders of " & Directory & " ?", _
vbInformation + vbYesNoCancel, "Search Sub-Folders?")

If varSubFolders = vbYes Then blnSubFolders = True
If varSubFolders = vbNo Then blnSubFolders = False
If varSubFolders = vbCancel Then Exit Sub


'Add new worksheet at end of workbook where results will be located
Application.ScreenUpdating = False
i = ActiveWorkbook.Sheets.Count
For Each WS In Worksheets
If IsNumeric(Right(WS.Name, 2)) Then N = Application.Max(N, Right(WS.Name, 2))
Next 'WS
Worksheets.Add After:=Worksheets(i)
On Error Resume Next
ActiveSheet.Name = "File_Listing " & Format$(N + 1, "00")
On Error GoTo Err_ListFiles
'Name the new worksheet and set up Titles
Range("A1").Value = " Hyperlink"
Range("B1").Value = "Path"
Range("C1").Value = "FileName"
Range("D1").Value = "Ext"
Range("E1").Value = "Size"
Range("F1").Value = "Date/Time"

r = r + 1

Application.StatusBar = "Please wait while search is in progress..."
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = Directory
'.FileName = "*.*"
.FileName = strFileNameFilter
'.SearchSubFolders = False
.SearchSubFolders = blnSubFolders
.Execute
For i = 1 To .FoundFiles.Count
strFileName = ""
strPath = ""
For Y = Len(.FoundFiles(i)) To 1 Step -1
If Mid(.FoundFiles(i), Y, 1) = "^#92;" Then
Exit For
End If
strFileName = Mid(.FoundFiles(i), Y, 1) & strFileName
Next Y
strPath = Left(.FoundFiles(i), Len(.FoundFiles(i)) - Len(strFileName))
strExtension = ""
For Y = Len(strFileName) To 1 Step -1
If Mid(strFileName, Y, 1) = "." Then
If Len(strFileName) - Y = 0 Then
strExtension = Right(strFileName, Len(strFileName) - Y)
strFileName = Left(strFileName, Y - 1)
Exit For
End If
End If
Next Y
Cells(r, 1) = .FoundFiles(i)
ActiveSheet.Hyperlinks.Add _
Anchor:=Cells(r, 1), Address:=.FoundFiles(i)
Cells(r, 2) = strPath
Cells(r, 3) = strFileName
Cells(r, 4) = strExtension
Cells(r, 5) = FileLen(.FoundFiles(i))
Cells(r, 6) = FileDateTime(.FoundFiles(i))
r = r + 1
Next i
End With
On Error GoTo Err_ListFiles
'formatting
Application.StatusBar = "Please wait while formatting is completed..."
Columns("E:E").NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
Columns("F:F").HorizontalAlignment = xlLeft
Rows(1).Insert Shift:=xlDown
LastRow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row
Rows("1:2").Font.Bold = True
Columns("A:F").AutoFit
With Columns("A:A")
If .ColumnWidth > 15 Then .ColumnWidth = 15
End With

If Len(strFileNameFilter) = 0 Then
strFileNameFilter = "All MSOffice products"
End If
If blnSubFolders Then
Directory = "(including Subfolders) - " & Directory
End If

Range("A1").Value = Chr$(32) & LastRow - 2 & " files(s) found for Criteria: " _
& Directory & strFileNameFilter & Chr$(34)
Range("A3").Select
ActiveWindow.FreezePanes = True
Application.ScreenUpdating = True

Exit_ListFiles:
Application.StatusBar = False
GoTo line99
Exit Sub

Err_ListFiles:
Application.ScreenUpdating = True
MsgBox "Error: " & Err & " - " & Err.Description
Resume Exit_ListFiles
line99:
ddd 'initiate macro to copy sheets into excel
End Sub

'===============================
Function GetDirectory(Optional msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer

' Root folder = Desktop
bInfo.pidlRoot = 0&

' Title in the dialog
If IsMissing(msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = msg
End If

' Type of directory to return
bInfo.ulFlags = &H1

' Display the dialog
x = SHBrowseForFolder(bInfo)

' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function

Sub ddd()
Dim appwd As Word.Application
Dim odoc As Word.Document
Dim wordxl As Range, wxl As Variant
Dim dk As String
Dim dkl As Long
Dim mydo As String
Set appwd = CreateObject("Word.Application")
Set wordxl = Range("C3:C1000")
For Each wxl In wordxl
If wxl = "" Then
appwd.Quit
Set appwd = Nothing
Exit Sub
End If
mydo = wxl
appwd.Documents.Open FileName:=mydo
dk = appwd.ActiveDocument.Name
dkl = Len(dk) - 4
dk = Left(dk, dkl)
appwd.ActiveDocument.Range.Copy
Sheets.Add.Move After:=Worksheets(Worksheets.Count) 'add a spreadsheet page for the new information
On Error Resume Next
ActiveSheet.Name = dk
On Error GoTo 0
ActiveSheet.[A1].PasteSpecial Paste:=xlPasteFormulas
appwd.ActiveDocument.Close
Next
End Sub

I hope that works. If you have any problems, let me know.
Tom

Oh, I forget to tell you one thing...You'll have to add MSWord objects to your VBA references. (In VBA editor, under Tools, References.)
Tom