Copying Data From Excel to Word without overwriting existing text - vba

Question

I have a report in Excel that I run every day. I pull the report from an email, do some filtering, write down some numbers and copy some of the table info from the Excel report.
The table in Excel, let's say it has data in columns A-Z. I'm trying to copy data from Excel and into Word based on certain filtering criteria. I have most of that down.
When I copy the filtered table from Excel into Word, and the table is being pasted beneath some text, the table overwrites the text in the Word document.
Const olFolderInbox As Integer = 6
'~~> Path for the attachment
Const AttachmentPath As String = "C:\Users\....."
Sub DownloadAttachmentFirstUnreadEmail()
Dim oOlAp As Object, oOlns As Object, oOlInb As Object, LastRow As Long, objDoc As Object, objWord As Object, objSelection As Object, nonProdCount As Integer, nonProdDT As Integer
Dim oOlItm As Object, oOlAtch As Object, fname As String, sFound As String, totalRowCount As Integer, wFound As String, wdRange As Word.Range, str As String, nonProdCopyToWord As Long
Dim wb As Workbook, uRng As Range
'~~> New File Name for the attachment
Dim NewFileName As String
NewFileName = "MorningOpsFile " & Format(Date, "MM-DD-YYYY")
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox).Folders("Folder Name Here")
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add
objWord.Visible = True
Set objSelection = objWord.Selection
'~~> Check if there are any actual unread emails
If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
MsgBox "NO Unread Email In Inbox"
Exit Sub
End If
'~~> Extract the attachment from the 1st unread email
For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
'~~> Check if the email actually has an attachment
If oOlItm.Attachments.Count <> 0 Then
For Each oOlAtch In oOlItm.Attachments
'~~> Download the attachment
oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename
Exit For
Next
Else
MsgBox "The First item doesn't have an attachment"
End If
Exit For
Next
'~~> Mark 1st unread email as read
For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
oOlItm.UnRead = False
DoEvents
oOlItm.Save
Exit For
Next
'--> Search for downloaded file without knowing exact filename
sFound = Dir(ActiveWorkbook.Path & "\*File Search String*.xlsx")
If sFound <> "" Then
Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & sFound
End If
Set uRng = ActiveSheet.Range("A1:A2")
'--> Set variable for last row in sheet containing data
LastRow = Sheets("Sheet1).Cells(Rows.Count, 1).End(xlUp).Row
'--> Apply filter to look for today's changes
With Sheets("Sheet 1").Select
Range("$A$1:AB" & LastRow).AutoFilter Field:=3, Criteria1:= _
xlFilterToday, Operator:=xlFilterDynamic
'--> Get a total row count of today's changes
totalRowCount = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
'--> Printout total rowcount number
' MsgBox totalRowCount
Set objDoc = objWord.Documents.Open("C:\Users\....docx")
objWord.Visible = True
'objWord.Activate
objDoc.Content.Select
objDoc.Content.Delete
objWord.Selection.TypeText vbNewLine
objWord.Selection.TypeText "Good Morning All" & vbNewLine
objWord.Selection.TypeText "We have " & totalRowCount & " total current day changes" & vbNewLine
End With
'--> Filter for non-Prod changes
ActiveSheet.Range("$A$1:AB" & LastRow).AutoFilter Field:=10, Criteria1:="QA", _
Operator:=xlOr, Criteria2:="Development"
'-->Count non-Prod changes
nonProdCount = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
'--> Put count of non-Prod changes in Word document
objWord.Selection.TypeText "We have " & nonProdCount & " non-production changes" & vbNewLine
'--> Filter for non-Prod changes with downtime
ActiveSheet.Range("$A$1:AB" & LastRow).AutoFilter Field:=11, Criteria1:="<>", _
Operator:=xlAnd
'--> Count non-Prod changes with downtime
nonProdDT = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
'--> Add non-prod downtime count to Word
objWord.Selection.TypeText nonProdDT & " with downtime" & vbNewLine
'--> Copy non-Prod rows with downtime from Excel to Word
'Set uRng = Union(Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible), (Range("G1:H" & LastRow).SpecialCells(xlCellTypeVisible)))
'uRng.Copy
ActiveSheet.Range("B1:F" & LastRow).EntireColumn.Hidden = True
ActiveSheet.Range("N1:Q" & LastRow).EntireColumn.Hidden = True
ActiveSheet.Range("Z1:AB" & LastRow).EntireColumn.Hidden = True
ActiveSheet.Range("A1:Y" & LastRow).SpecialCells(xlCellTypeVisible).Copy
objWord.Selection.TypeText vbNewLine
objDoc.Content.Paste
End Sub
How can I copy the filtered table in Excel to Word without overwriting what is in the Word document?

Answer 1

This is your problem:
objWord.Selection.TypeText vbNewLine
objDoc.Content.Paste
objDoc.Content is the entire main body of the document - the entire "content", excluding headers, footers, any text in objects that have "text wrap" formatting, etc.
You can use objWord.Selection.Paste, analog to the first line, above.
Perferable, from a programmer's perspective, would be to work with Word Range objects. Something like:
Dim wdRange as Object
Set wdRange = objWord.Selection.Range
wdRange.InsertParagraph
wdRange.Collapse 0
wdRange.Paste
The reason this is considered preferable is that not relying on Selection is more reliable. Theoretically, something could change the Selection while your code is running. A Range will remain static. This also makes it easier to understand where things are being inserted/manipulated (the code is more "self-documenting").