copy paste not working in windows 10 office 365 while splitting word document using VBA - vba

Question

The following code split the document by section breaks. however it is working correctly in windows 7 but not in windows 10 office 365, having "run time error 4605 : the command is not available." on windows 10? while I try to paste the copied content using oNewDoc.Range.Paste. I came to know it was due to oNewDoc windows not activate or pasting take place without waiting to oNewDoc to be created. because when I press debug and wait for 1 second then run again it executes correctly.
Private Sub GenerateFiles_Click()
'Pages Update 1.0 By M.B.A.
Dim oNewDoc As Document
Dim oDoc As Document
Dim CR As Range
Dim firstLine As String
Dim strLine As String
Dim DocName As String
Dim pdfName As String
Dim arrSplit As Variant
Dim Counter As Integer
Dim i As Integer
Dim PS As String
PS = Application.PathSeparator
'Progress
pBarCurrent 0
If pdfCheck.Value = False And docCheck.Value = False Then
PagesLB = "**Please Select at least one check boxes!"
Beep
Exit Sub
End If
Set oDoc = ActiveDocument
Set CR = oDoc.Range
Letters = oDoc.Range.Information(wdActiveEndSectionNumber)
Counter = 1
While Counter < Letters + 1
With oDoc.Sections.First.Range
.MoveEnd wdSection, 0
.MoveEnd wdCharacter, -1
.Copy
'.Select
Set oNewDoc = Documents.Add(Visible:=True)
oNewDoc.Range.Paste 'Run-time error '4605': This command is not available
End With
firstLine = oNewDoc.Paragraphs(1).Range.Text
For i = 1 To 2
strLine = oNewDoc.Paragraphs(i).Range.Text
If InStr(strLine, ".pdf") > 0 Then
arrSplit = Split(strLine, ".pdf")
DocName = arrSplit(0) & ".pdf"
Exit For
End If
Next i
If i = 3 Then
DocName = Left(firstLine, 45)
DocName = Replace(DocName, vbCr, "")
End If
DocName = Replace(DocName, Chr(11), "")
pdfName = Counter & " - " & DocName & IIf(i = 3, ".pdf", "")
DocName = Counter & " - " & IIf(i < 2, Replace(DocName, ".pdf", ""), DocName) & ".docx"
'Debug.Print pdfName; vbNewLine; DocName
If docCheck Then
oNewDoc.SaveAs FileName:=oDoc.Path & PS & ValidWBName(DocName), AddToRecentFiles:=False
End If
If pdfCheck Then
oNewDoc.SaveAs FileName:=oDoc.Path & PS & ValidWBName(pdfName), FileFormat:=wdFormatPDF
End If
oDoc.Sections.First.Range.Cut
'== Progress Bar =='
DoEvents
PagesLB = " Letter " & Counter & " of " & Letters & vbCr & " " & Int((Counter / (Letters)) * 100) & "% Completed..."
pBarCurrent Int((Counter / (Letters)) * 100)
oNewDoc.Close False
Counter = Counter + 1
Wend
PagesLB = Letters & " Letters has been Created..."
oDoc.Close wdDoNotSaveChanges
Beep
End Sub

Answer 1

You can avoid using the clipboard by using the FormattedText property
With oDoc.Sections.First.Range
.MoveEnd wdSection, 0
.MoveEnd wdCharacter, -1
Set oNewDoc = Documents.Add(Visible:=True)
oNewDoc.Range.FormattedText = .FormattedText
End With