View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
[email protected] jamasm2010@gmail.com is offline
external usenet poster
 
Posts: 33
Default Print contents of sub folders

On Tuesday, August 7, 2012 10:07:07 AM UTC-5, (unknown) wrote:
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


Never mind - I got it to work.
James