Print contents of sub folders

  • Thread starter Thread starter jamasm2010
  • Start date Start date
J

jamasm2010

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
 
Hi, I am using XL 2007 (Windows XP) and I am trying to print the contentsof all the sub folders, which contain only Word documents. I get the debugprint 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 FnumAs 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.SubfoldersListFilesInSubfolders 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
Click to expand...

Never mind - I got it to work.
James
 
Back
Top