Hi,
I am using XL 2007 (Windows XP) and I am trying to print the contents of all the sub folders, which contain only Word documents. I get the debug print to work great, but I keep getting a bad filename on the actual printout. Can anyone help me out?
Thanks.
James

Dim MyFiles() As String
Dim Fnum As Long
Dim FileExt As String
Sub GetData_Example7()
'Copy cells from folder and subfolder(s)
Dim Subfolders As Boolean
Dim Fso_Obj As Object, RootFolder As Object
Dim SubFolderInRoot As Object, file As Object
Dim RootPath As String
' Dim sh As Worksheet, destrange As Range
Dim rnum As Long

'Loop through all files in the Root folder
RootPath = AYPpathway & Year(Now)

'Loop through the subfolders True or False
Subfolders = True

'Loop through files with this extension (*.doc* is all Word files)
FileExt = "*.doc*"


'Add a slash at the end if the user forget it
If Right(RootPath, 1) < "\" Then
RootPath = RootPath & "\"
End If


Set Fso_Obj = CreateObject("Scripting.FileSystemObject")
If Not Fso_Obj.FolderExists(RootPath) Then
MsgBox RootPath & " Not exist"
Exit Sub
End If


Set RootFolder = Fso_Obj.GetFolder(RootPath)


'Fill the array(myFiles)with the list of Excel files in the folder(s)
Erase MyFiles()
Fnum = 0


'Loop through the files in the RootFolder
For Each file In RootFolder.Files
If LCase(file.Name) Like LCase(FileExt) Then
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = RootPath & file.Name
End If
Next file


'Loop through the files in the Sub Folders if SubFolders = True
If Subfolders Then
Call ListFilesInSubfolders(OfFolder:=RootFolder)
End If
End Sub
Sub ListFilesInSubfolders(OfFolder As Object)
'Origenal SubFolder code from Chip Pearson
'http://www.cpearson.com/Excel/RecursionAndFSO.htm
'Changed by ron de Bruin, 23-Dec-2007
Dim SubFolder As Object
Dim fileInSubfolder As Object

On Error Resume Next
Set WordApp = Word.Application
If WordApp Is Nothing Then
Set WordApp = New Word.Application
End If
On Error GoTo 0


For Each SubFolder In OfFolder.Subfolders
ListFilesInSubfolders OfFolder:=SubFolder


For Each fileInSubfolder In SubFolder.Files
If LCase(fileInSubfolder.Name) Like LCase(FileExt) Then
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = SubFolder & "\" & fileInSubfolder.Name
Debug.Print MyFiles(Fnum)
With WordApp.Documents(MyFiles(Fnum)) <<BAD FILENAME ERROR
.Open
.PrintOut
.Close False
End With
End If
Next fileInSubfolder
Next SubFolder
End Sub