Open Multiple Word Files, Copy/Paste into One File

[RyGuy]

This code used to work in my Word 2002; not working in 2007:
Sub Foo()
Dim i As Long
Application.ScreenUpdating = False
Documents.Add
With Application.FileSearch
'Search in foldername
..LookIn = "C:\Documents and Settings\Excel\Desktop\Word Files\"
..SearchSubFolders = False
..FileName = "*.doc"
..Execute
For i = 1 To .FoundFiles.Count
If InStr(.FoundFiles(i), "~") = 0 Then
Selection.InsertFile FileName:=(.FoundFiles(i)), _
ConfirmConversions:=False, Link:=False, Attachment:=False
Selection.InsertBreak Type:=wdPageBreak
End If
Next i
End With
End Sub

The error is: Run-Time error 5111
This command is not available on this platform.

This is the line that errors out:
With Application.FileSearch

 

[Doug Robbins - Word MVP]

You will need to use the Dir$ method as done in the article
http://www.word.mvps.org/FAQs/MacrosVBA/InsertFileNames.htm

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

 

[ryguy7272]

Thanks Doug. I tried the code below:

Sub Foo()
Dim i As Long
Application.ScreenUpdating = False
Documents.Add

With FileSystemObject
MyName = Dir$(MyPath & "*.*")

Do While MyName <> ""
.SearchSubFolders = False
.FileName = "*.doc"
.Execute
'Selection.InsertAfter MyName & vbCr
MyName = Dir
Loop

For i = 1 To .FoundFiles.Count
If InStr(.FoundFiles(i), "~") = 0 Then
Selection.InsertFile FileName:=(.FoundFiles(i)), _
ConfirmConversions:=False, Link:=False, Attachment:=False
Selection.InsertBreak Type:=wdPageBreak
End If
Next i

End With
End Sub

Now I getting a Run-Time Error 424
Object Required

Error occurs here:
..SearchSubFolders = False

Any thoughts on how to resolve this?

Thanks,
Ryan---

 

[Doug Robbins - Word MVP]

You have omitted an essential part of the code in the article to which I
referred you and you need to completely re-write your macro. At the moment,
it still includes inappropriate elements of your original attempt

Use:

Dim MyPath As String
Dim MyName As String

'let user select a path
With Dialogs(wdDialogCopyFile)
If .Display() <> -1 Then Exit Sub
MyPath = .Directory
End With

'strip quotation marks from path

If Len(MyPath) = 0 Then Exit Sub

If Asc(MyPath) = 34 Then
MyPath = Mid$(MyPath, 2, Len(MyPath) - 2)
End If

'get files from the selected path
'and insert them into the doc
MyName = Dir$(MyPath & "*.doc")
Do While MyName <> "" And InStr(MyName, "~") = 0
Selection.InsertFile FileName:=MyPath & MyName, _
ConfirmConversions:=False, Link:=False, Attachment:=False
Selection.InsertBreak Type:=wdPageBreak
MyName = Dir
Loop



--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

 

[Jay Freedman]

Hi Ryan,

The Dir$ method works without any need for a FileSystemObject. Try
this version:

Sub Foo()
Dim i As Long
Dim MyName As String, MyPath As String
Application.ScreenUpdating = False
Documents.Add

MyPath = "C:\temp\" ' <= change this as necessary

MyName = Dir$(MyPath & "*.doc") ' not *.* if you just want doc files

Do While MyName <> ""
If InStr(MyName, "~") = 0 Then
Selection.InsertFile _
FileName:="""" & MyPath & MyName & """", _
ConfirmConversions:=False, Link:=False, _
Attachment:=False
Selection.InsertBreak Type:=wdPageBreak
End If

MyName = Dir ' gets the next doc file in the directory
Loop

End Sub


If you do want to use a FileSystemObject instead (*not* in addition),
then the first thing you need to do is (in the VBA editor) go to the
Tools > References dialog and put a check mark next to "Microsoft
Scripting Runtime". That's the library that contains the code for the
FileSystemObject. Then you need to learn how to use the FSO and its
methods properly. Here's the equivalent macro:

Sub Foo2()

' Uses File System Object
' Need to have reference to Microsoft Scripting Runtime

On Error GoTo Show_Err
Dim oFS As FileSystemObject
Dim MyName As String, MyPath As String
Dim MyFolder As Folder, MyFile As File

Application.ScreenUpdating = False
Documents.Add

Set oFS = New FileSystemObject
MyPath = "C:\temp\" ' <= change this as necessary

Set MyFolder = oFS.GetFolder(MyPath)
For Each MyFile In MyFolder.Files
If (InStr(MyFile.Name, ".doc") = Len(MyFile.Name) - 3) _
And (InStr(MyFile.Name, "~") = 0) Then
Selection.InsertFile _
FileName:="""" & MyPath & MyFile.Name & """", _
ConfirmConversions:=False, Link:=False, _
Attachment:=False
Selection.InsertBreak Type:=wdPageBreak
End If
Next

If Not oFS Is Nothing Then Set oFS = Nothing

Show_Err:

If Err <> 0 Then
MsgBox Err.Number & " - " & Err.Description
Err.Clear
End If
End Sub

--
Regards,
Jay Freedman
Microsoft Word MVP
Email cannot be acknowledged; please post all follow-ups to the
newsgroup so all may benefit.

 

[RyGuy]

Thanks Doug and Jay! Both macros worked excellent!!
Ryan--

 

[neha garg]

I'm trying to open .xlsx file from given macro code that I got form the following link :

http://www.eggheadcafe.com/software...tiple-word-files-copypaste-into-one-file.aspx
"Macro Code"

Sub Foo()
Dim i As Long
Dim MyName As String, MyPath As String

Application.ScreenUpdating = False
Documents.Add

MyPath = "I:\CU Material\FEEDBACK FORM\FEEDBACK\"
' <= change this as necessary

MyName = Dir$(MyPath & "*.xlsx") ' not *.* if you just want doc files

Do While MyName <> ""
If InStr(MyName, "~") = 0 Then
Selection.InsertFile _
Filename:="""" & MyPath & MyName & """", _
ConfirmConversions:=False, Link:=False, _
Attachment:=False
Selection.InsertBreak Type:=wdPageBreak
End If

MyName = Dir ' gets the next doc file in the directory
Loop

End Sub


And getting the following error :
Run-time error '424'
Object required

Please anybody can help me?

 

[neha garg]

I'm trying to open .xlsx file from given macro code that I got form the following link :

http://www.eggheadcafe.com/software...tiple-word-files-copypaste-into-one-file.aspx
"Macro Code"
Sub Foo2()

' Uses File System Object
' Need to have reference to Microsoft Scripting Runtime

On Error GoTo Show_Err
Dim oFS As FileSystemObject
Dim MyName As String, MyPath As String
Dim MyFolder As Folder, MyFile As File

Application.ScreenUpdating = False
Documents.Add

Set oFS = New FileSystemObject
MyPath = "I:\CU Material\FEEDBACK FORM\FEEDBACK\"

Set MyFolder = oFS.GetFolder(MyPath)
For Each MyFile In MyFolder.Files
If (InStr(MyFile.Name, ".xlsx") = Len(MyFile.Name) - 3) _
And (InStr(MyFile.Name, "~") = 0) Then
Selection.InsertFile _
Filename:="""" & MyPath & MyFile.Name & """", _
ConfirmConversions:=False, Link:=False, _
Attachment:=False
Selection.InsertBreak Type:=wdPageBreak
End If
Next

If Not oFS Is Nothing Then Set oFS = Nothing

Show_Err:

If Err <> 0 Then
MsgBox Err.Number & " - " & Err.Description
Err.Clear
End If
End Sub





And getting the following error :
Run-time error '424'
Object required

Please anybody can help me?

 

[dedawson]

Here's a different approach that may well give you what you're looking
for.

The hot tip is to let the built-in File Open dialog do the heavy
lifting of allowing the user to select the files they want to
process. Using CTRL-click they can select one or more files from the
dialog. When they click OK, the code will cycle through the list of
selected files, open the current one, call the processing sub (Replace
Patch_Specific_Values with the name of your routine), and then go to
the next file. Note that your processing Sub should save and close
the opened file when done.

Sub Select_and_Process_Files()

Dim filenames As Variant

' set the array to a variable; the True allows for multi-select
filenames = Application.GetOpenFilename("SLK Files (*.slk),
*.slk", , , , True)
iFileNumber = 1


While iFileNumber <= UBound(filenames) ' ubound determines how many
items in the array
Workbooks.Open filenames(iFileNumber) 'Opens the selected files


' Call sub to perform desired actions on current file, save and close
must be performed by sub
Patch_Specific_Values
iFileNumber = iFileNumber + 1

Wend

End Sub ' Select_and_Process_Files

 

[Sherri Miller]

Hi.

I am a newbie. I want to accomplish the same thing as this macro is but I need for it to parse through all of the subdirectories as well. I think I need to use RecursiveDir instead of Dir. Can you help?