Solved: InsertFile Position Goes To Start of Doc

[mphill]

Greetings,
I have made numerous attempts to insert bookmarked text from another document in the correct location but it always results in the text being placed at the start of the document which pushes the existing text (obtained from a form in a class - clsHeading) to the end of the document.

Is there a way to "insertafter" the class is finished, then do the ".InsertFile"?
Thanks for any suggestions.



Sub designExceptions()
Set r = ActiveDocument.Range
' Get the standard To, From and Subject items in the class Heading
Dim oclsHeading As New clsHeading
oclsHeading.docHeadings

'Moves to end of line of found word "Dear"
'"Dear" is not needed in this letter
With r
While .Find.Execute(findtext:="Dear", Forward:=True) = True
.MoveEnd unit:=wdParagraph
.Text = ""
Wend
End With

Selection.Collapse Direction:=wdCollapseEnd
Selection.InsertFile FileName:="C:\Users\MPHILL\Desktop\PDletters\DesignExceptions_Recons.dotx", _
Range:="DesignExceptionsWYDOT", ConfirmConversions:=False, Link:=False, Attachment:=False

ActiveDocument.Range.Select
With Selection.ParagraphFormat
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
End With
Selection.Collapse

' Get standard name list for CC
Dim oclsCCboxchecked As New clsCCBoxChecked
oclsCCboxchecked.ccBoxChecked

End Sub

[mphill]

This seems to resolve the issue

ActiveDocument.Bookmarks("\EndOfDoc").Select in place of the collapse line.

[fumei]

So many things...

1. I have no idea where your selection is starting. But whereever it is the InsertFile is where the file goes. If it is a single point at the start of the document - is it? - then that is where it goes.

2. you mention "bookmarked text", but there is NOTHING in your code dealing with either bookmaks, or text.

3. you mention a Class (clsHeading?), but does: Dim oclsHeading As New clsHeading
oclsHeading.docHeadings actually do anything? Or anything relevant to what you seem to want? Who knows?

4. Are you possibly confusing range and selection? it seems so.

All in all, unless you give better information, it will be hard to suggest anything.

[mphill]

Hi Fumei,

While the "\EndofDoc" worked in one module it is not working in another.
The new document has no bookmarks other than the "StartofDoc and EndofDoc" since there are over 50 letters to generate with various greetings, text body, signatures, etc. The text body is bookmarked in a dotx however and is being called in.

The clsHeadingClosing (I renamed it) looks like the code below.

Sub docHeadings()

Set r = ActiveDocument.Range

' Selection.InsertDateTime datetimeFormat:="MMMM dd, yyyy" & vbCr

If frmPDList.cbTO.Text = "" Then
MsgBox "Please select a name to send letter to."
Exit Sub
Else
Dim scboTO As String
Dim T() As String
Dim N As Long

' ActiveDocument.Bookmarks("TO").Select
ActiveDocument.Bookmarks("\StartofDoc").Select
' Parse through the individual data in the TO combo box that is separated by ; and place on a new line and tab in
ActiveDocument.Bookmarks("\StartofDoc").Range.Text = frmPDList.lblTo.Caption & vbTab & vbTab
' ActiveDocument.Bookmarks("TO").Range.Text = frmPDList.lblTo.Caption & vbTab & vbTab ' Use TO label for text
scboTO = frmPDList.cbTO.Text
' scboTO = "John Smith, P.E.;Resident Engineer;Wyoming Department of Transportation;100 Anywhere St.;Worland, WY 82000"
T = SplitEx(scboTO, True, ";")
For N = LBound(T) To UBound(T) Step 1
r.InsertAfter T(N) & vbCr & vbTab & vbTab
Next N
End If

' Split the text in the FROM combo box
Dim sSenderNameSplit As String
Dim sSenderTitle As String

With r
.InsertAfter vbCr

sSenderNameSplit = Split(frmPDList.cbFrom.Text, ";")(0)
.InsertAfter frmPDList.lblFrom.Caption & vbTab & vbTab & sSenderNameSplit & vbCr

sSenderTitle = Split(frmPDList.cbFrom.Text, ";")(1)
.InsertAfter vbTab & vbTab & sSenderTitle & vbCr & vbCr

' .InsertAfter frmPDList.lblSubject.Caption & vbTab & frmPDList.txbSubject.Text & vbCr
.InsertAfter frmPDList.lblSubject.Caption & vbTab & frmPDList.cboSubject.Text & vbCr

.InsertAfter vbTab & vbTab & frmPDList.lblProject.Caption & (" ") & frmPDList.txbProject.Text & vbCr

.InsertAfter vbTab & vbTab & frmPDList.lblRoad.Caption & (" ") & frmPDList.txbRoad.Text & vbCr

.InsertAfter vbTab & vbTab & frmPDList.lblSection.Caption & (" ") & frmPDList.txbSection.Text & vbCr

.InsertAfter vbTab & vbTab & frmPDList.lblCounty.Caption & (" ") & frmPDList.txbCounty.Text & vbCr & vbCr
.Collapse wdCollapseEnd

.InsertAfter ("Dear Mr.\Ms. ") & Split(frmPDList.cbTO.Text, ",")(0) & ":" & vbCrLf
.Font.Color = wdColorRed
.Collapse wdCollapseEnd

.InsertAfter vbCrLf
End With

End Sub

Function SplitEx(ByVal InString As String, IgnoreDoubleDelmiters As Boolean, _
ParamArray Delims() As Variant) As String()
Dim Arr() As String
Dim Ndx As Long
Dim N As Long

If Len(InString) = 0 Then
SplitEx = Arr
Exit Function
End If
If IgnoreDoubleDelmiters = True Then
For Ndx = LBound(Delims) To UBound(Delims)
N = InStr(1, InString, Delims(Ndx) & Delims(Ndx), vbTextCompare)
Do Until N = 0
InString = Replace(InString, Delims(Ndx) & Delims(Ndx), Delims(Ndx))
N = InStr(1, InString, Delims(Ndx) & Delims(Ndx), vbTextCompare)
Loop
Next Ndx
End If


ReDim Arr(1 To Len(InString))
For Ndx = LBound(Delims) To UBound(Delims)
InString = Replace(InString, Delims(Ndx), Chr(1))
Next Ndx
Arr = Split(InString, Chr(1))
SplitEx = Arr
End Function

Then some letters do not require the "Dear Whom Ever" so it may need to be removed like this particular case.

Sub finalRecon()
Set r = ActiveDocument.Range

' Get the standard To, From and Subject items in the class Heading
Dim oclsHeading As New clsHeadingClosing
oclsHeading.docHeadings

'Finds word "Dear"
'"Dear Whom Ever" is not needed in this letter so wipe out the entire line
With r
While .Find.Execute(findtext:="Dear", Forward:=True) = True
.MoveEnd unit:=wdParagraph
.Text = ""
Wend
End With


' r.Collapse wdCollapseEnd
' r.InsertAfter vbCrLf
ActiveDocument.Bookmarks("\EndOfDoc").Select

Selection.InsertFile FileName:=docPathRecons, Range:="finalRecon", _
ConfirmConversions:=False, Link:=False, Attachment:=False

ActiveDocument.Range.Select
With Selection.ParagraphFormat
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
End With
Selection.Collapse

' This is incase a closing is needed later
' Dim oclsclosing As New clsHeadingClosing
' oclsclosing.docClosing


r.InsertBreak Type:=wdPageBreak

' Get standard name list for CC
Dim oclsCCPeople As New clsCCPeople
oclsCCPeople.ccfinalRecon

' Get names from checked list for CC
Dim oclsCCboxchecked As New clsCCBoxChecked
oclsCCboxchecked.ccBoxChecked

' Get underlined Memorandum text and place at beginning of document
Dim oclsMemorandum As New clsMemorandum
oclsMemorandum.addMemorandum


End Sub

I think the removal of the text is now throwing the bookmarked text prior to the TO: line. I have tried various collapse statments, etc. but it does not work in this finalRecon module.

So you are right on the range vs. selection confusion. I information on how to stop at a specific point then. As previously mentioned it works on one module but not another.

This module works correctly.

Sub draftRecon()

Dim sSenderNameSplit As String
Dim sSenderTitle As String

Set r = ActiveDocument.Range
' Get the standard To, From and Subject items in the class Heading
Dim oclsHeading As New clsHeadingClosing
oclsHeading.docHeadings

'Selection.Collapse Direction:=wdCollapseEnd
ActiveDocument.Bookmarks("\EndOfDoc").Select

Selection.InsertFile FileName:=docPathRecons, Range:="draftRecon", _
ConfirmConversions:=False, Link:=False, Attachment:=False

ActiveDocument.Range.Select
With Selection.ParagraphFormat
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
End With
Selection.Collapse

Dim oclsclosing As New clsHeadingClosing
oclsclosing.docClosing

' Get standard name list for CC
Dim oclsCCPeople As New clsCCPeople
oclsCCPeople.ccDraftRecon

' Get names from checked list for CC
Dim oclsCCboxchecked As New clsCCBoxChecked
oclsCCboxchecked.ccBoxChecked

End Sub