macro to rid of the extra first page

S

sals

Hi there,

I'm using this code to concatenate many files into one.
I keep getting an extra page at the beggining.

What am I doing wrong?

Thanks,

S

Sub concatFiles()
Dim resp As Integer
Dim activeDir As String
Dim fileType As String

resp = MsgBox("This macro concatenates all DOC files in the
directory you select next.", vbOKCancel)
If resp = vbCancel Then Exit Sub

fileType = "doc"
If activeDir = "" Then
activeDir = "F:\Doc" 'getFullPath(UCase(fileType) & "|*." &
UCase(fileType))
End If
If activeDir <> "" Then
With Application.FileSearch
.NewSearch
.LookIn = activeDir
.SearchSubFolders = False
.FileName = "*." & fileType
.MatchTextExactly = False
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Selection.InsertBreak Type:=wdSectionBreakOddPage
Selection.InsertFile FileName:=.FoundFiles(i),
Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False
Next i
Else
MsgBox "There were no files found to concatenate."
End If
End With
Else
Exit Sub
End If
MsgBox "Concatenated " & i - 1 & " files."
End Sub
 
G

Greg

Sals,

I am a novice, but I the reason for the blank page at the
beginning was your code to insert a section break before
inserting each file.

If you reversed those two instructions, then you would
have a blank page at the end. I modified your code a bit
to prevent the extra page at the beginning or end and ran
a limited (very limited test). It seems to work:

Sub concatFiles()
Dim resp As Integer
Dim activeDir As String
Dim fileType As String

resp = MsgBox("This macro concatenates all DOC files
in the directory you select next.", vbOKCancel)
If resp = vbCancel Then Exit Sub

fileType = "doc"
If activeDir = "" Then
activeDir = "D:\" 'getFullPath(UCase(fileType)
& "|*." & UCase(fileType))
End If
If activeDir <> "" Then
With Application.FileSearch
.NewSearch
.LookIn = activeDir
.SearchSubFolders = False
.FileName = "*." & fileType
.MatchTextExactly = False
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count - 1
Selection.InsertFile
FileName:=.FoundFiles(i), Range:="",
ConfirmConversions:=False, Link:=False, Attachment:=False
Selection.InsertBreak
Type:=wdSectionBreakOddPage
Next i
If i = .FoundFiles.Count Then
Selection.InsertFile
FileName:=.FoundFiles(i), Range:="",
ConfirmConversions:=False, Link:=False, Attachment:=False

End If
Else
MsgBox "There were no files found to
concatenate."
End If
End With
Else
Exit Sub
End If
MsgBox "Concatenated " & i & " files."
End Sub
 
G

Greg

Sals,

Played with this a bit more and the following seems to
work nicely. An expert is likely to come along explain
how I got it all wrong. :)


Sub concatFiles()
Dim Resp As VbMsgBoxResult
Dim activeDir As String
Dim fileType As String

Resp = MsgBox("This macro concatenates all DOC files in
the selected directory.", vbOKCancel)
If Resp = vbCancel Then
MsgBox "Cancelled by User"
Exit Sub
End If

' Get the folder containing the files
With Dialogs(wdDialogCopyFile)
If .Display <> 0 Then
activeDir = .directory
Else
MsgBox "Cancelled by User"
Exit Sub
End If
End With

fileType = "doc"
If activeDir <> "" Then
With Application.FileSearch
.NewSearch
.LookIn = activeDir
.SearchSubFolders = False
.FileName = "*." & fileType
.MatchTextExactly = False
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count - 1
Selection.InsertFile FileName:=.FoundFiles(i),
Range:="", ConfirmConversions:=False, Link:=False,
Attachment:=False
Selection.InsertBreak Type:=wdSectionBreakOddPage
Next i
If i = .FoundFiles.Count Then
Selection.InsertFile FileName:=.FoundFiles(i),
Range:="", ConfirmConversions:=False, Link:=False,
Attachment:=False
End If
Else
MsgBox "There were no files found to concatenate."
End If
End With
Else
Exit Sub
End If
MsgBox "Concatenated " & i & " files."
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top