Instead of
Target.Bookmarks("bk" + CurName).Range.FormattedText =
Source.Range.FormattedText
Set Source = Documents.Close(RawPath +
CurName)(savechanges:=wdDoNotSaveChanges)
you should have
Target.Close wdSaveChanges
Source.Close wdDoNotSaveChanges
--
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
"afswa" wrote in message
...
Forgot to paste the code:
For i = Marks To 1 Step -1
If Left(aMarksArray(i), 2) = "bk" Then
CurName = Right(aMarksArray(i), Len(aMarksArray(i)) - 2)
Set Source = Documents.Open(RawPath + CurName)
ViewType = wdNormalView
Application.Options.Pagination = False
LockFields
ActiveDocument.MailMerge.MainDocumentType = wdNotAMergeDocument
Set Target = Documents.Open(ThisContainer)
Target.Bookmarks("bk" + CurName).Range.FormattedText =
Source.Range.FormattedText
Set Source = Documents.Close(RawPath +
CurName)(savechanges:=wdDoNotSaveChanges)
End If
Next
Thanks
"Doug Robbins - Word MVP" wrote:
Instead of this
'Incorporate into container
ActiveDocument.Range.WholeStory
ActiveDocument.Select
Selection.Copy
ActiveDocument.MailMerge.DataSource.Close
Application.ActiveWindow.Close
savechanges:=wdDoNotSaveChanges
Documents(ThisContainer).Select
Selection.Collapse (Start)
ActiveDocument.Bookmarks("bk" + CurName).Select
Selection.Paste
End If
Next
You should do something like
Dim Source as Document, Target as Document
Set Source = Documents.Open ("path\filename"), addtorecentfiles:=False
Set Target = Documents.Open("path\filename"), addtorecentfiles:=False
Target.Bookmarks("bk" + CurName).Range.FormattedText =
Source.Range.FormattedText
This avoids use of the selection and all of the selecting that is going
on
with your code maybe what is causing the problem.
--
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
"afswa" wrote in message
...
All main code - hope it makes some sense!
Private RawPath
Private LockedPath
Private MergedPath
Private ThisContainer
Private LookupPath
Option Base 1
Static Sub LockDocuments(Edition As String, Version As String)
' 8/5 add update to header/footer
Dim Marks As Integer
Dim i As Integer
Dim CurName As String
Dim aMarksArray() As String
Dim Month As String
Dim Year As String
Dim MyTOC As TableOfContents
Dim myIndex As Index
' Turn off display, establish which document called routine and set
up
all
paths
Year = "2007"
Month = "May"
CurName = Application.ActiveDocument.Name
RawPath = "C:\Documents and Settings\All Users\Documents\Work\AS
Book\"
+ Year + "\" + Month + "\Raw\"
LockedPath = "C:\Documents and Settings\All Users\Documents\Work\AS
Book\" + Year + "\" + Month + "\Locked\"
MergedPath = "C:\Documents and Settings\All Users\Documents\Work\AS
Book\" + Year + "\" + Month + "\Merged\"
LookupPath = "C:\Documents and Settings\All Users\Documents\Work\AS
Book\Lookup\Document Data.xls"
With Application
.ScreenUpdating = False
.Options.Pagination = False
End With
' Open relevant container document and freeze relevant bookmarks in
main
body then in header/footers,
' then unlock from data source.
ThisContainer = RawPath + "Outline " + Edition + ".doc"
Documents.Open (ThisContainer), addtorecentfiles:=False
LockFields
LockHeaders
ActiveDocument.MailMerge.MainDocumentType = wdNotAMergeDocument
ActiveWindow.View.Type = wdNormalView
Application.Options.Pagination = False
' Save modified Outline under new file name
' ThisContainer = MergedPath + "The Red Guide - " + Edition + " - " +
Version + ".doc"
ThisContainer = MergedPath + "The Red Guide - " + Edition + "
Edition"
+
" - " + CStr(Version) + ".doc"
ActiveDocument.SaveAs (ThisContainer)
Marks = ActiveDocument.Bookmarks.Count
ReDim aMarksArray(Marks)
For i = 1 To Marks
aMarksArray(i) = ActiveDocument.Bookmarks(i).Name
Next i
' Loop through bookmarks backwards (so as not to end up doing
alternate
ones when deletion takes place)
For i = Marks To 1 Step -1
If Left(aMarksArray(i), 2) = "bk" Then
CurName = Right(aMarksArray(i), Len(aMarksArray(i)) - 2)
Documents.Open (RawPath + CurName), addtorecentfiles:=False
ViewType = wdNormalView
Application.Options.Pagination = False
' Lock all mergefields and separate from datasource
LockFields
ActiveDocument.MailMerge.MainDocumentType = wdNotAMergeDocument
' Incorporate into container
ActiveDocument.Range.WholeStory
ActiveDocument.Select
Selection.Copy
ActiveDocument.MailMerge.DataSource.Close
Application.ActiveWindow.Close
savechanges:=wdDoNotSaveChanges
Documents(ThisContainer).Select
Selection.Collapse (Start)
ActiveDocument.Bookmarks("bk" + CurName).Select
Selection.Paste
End If
Next
' Move completed container document to "Merged" folder and update
fields.
Selection.HomeKey Unit:=wdStory
ViewType = wdPrintView
Application.ActiveWindow.View = wdPrintView
Application.Options.Pagination = True
ActiveDocument.Save
Application.ScreenUpdating = True
ActiveDocument.Close
End Sub
Sub LockFields(Optional result As Boolean) 'Dummy
' Sub routine to lock ALL fields in main body of text OTHER THAN
hyperlinks as values rather than code.
For Each Field In ActiveDocument.Fields
If Field.Type = wdFieldMergeField Or Field.Type = wdFieldRef Or
Field.Type = wdFieldSequence Or Field.Type = wdFieldPage Then
Field.Unlink
End If
Next Field
End Sub
Sub LockHeaders(Optional result As Boolean) 'Dummy
' Subroutine to lock ALL the fields in the headers and footers EXCEPT
page
numbers as values rather than code.
Dim fField As Field
Dim sSection As Section
Dim hHeader As HeaderFooter
Dim hFooter As HeaderFooter
For Each sSection In ActiveDocument.Sections
For Each hHeader In sSection.Headers
If hHeader.Exists Then
For Each fField In hHeader.Range.Fields
fField.Unlink
Next fField
End If
Next hHeader
For Each fFooter In sSection.Footers
If fFooter.Exists Then
For Each fField In fFooter.Range.Fields
If fField.Type wdFieldPage Then
fField.Unlink
End If
Next fField
End If
Next fFooter
Next sSection
End Sub
"Doug Robbins - Word MVP" wrote:
I would suggest that you avoid using the Selection object. Show us
all
of
your code so that appropriate modifications can be suggested.
--
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
"afswa" wrote in message
...
Thanks Doug - will try the registry hack and save my finger.
The code around the stall is with the highlight appearing at the
"Close
line"
' Incorporate into container
ActiveDocument.Range.WholeStory
ActiveDocument.Select
Selection.Copy
Application.ActiveWindow.Close savechanges:=wdDoNotSaveChanges
Documents(ThisContainer).Select
Selection.Collapse (Start)
ActiveDocument.Bookmarks("bk" + CurName).Select
Selection.Paste
At this point the code has looped past here around 250 times.
"Doug Robbins - Word MVP" wrote:
For the SQL issue, see the following Knowledge Base article:
"Opening This Will Run the Following SQL Command" Message When You
Open a
Word Document - 825765 at:
http://support.microsoft.com?kbid=825765
I am not sure about your error message though. If you click on
debug
when
you get the error message, what line of your code is highlighted?
--
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
"afswa" wrote in message
...
I have a routine in VBA which assembles a master document from a
number
of
subdocuments each of which uses a mail-merge to update
information
before
being copied to the main document. All has been going weell, but
now
it
is
stopping with the above message at around 250 (?256)
sub-documents.
Currently
I have a need for this to hold out up to around 350. Any
thoughts.
Also
Any
way of stopping the SQL confirmation dialogue box from appearing
on
each
document?