Spaces missing in text strings imported from a Word doc

[BobTheSpreadsheetBuilder]

Hi,

I have put together a working script that opens a selected word document, searches through it for key words, and pastes results into the spreadsheet. See below my import of a song lyrics. Apologies for poor quality photo.

The problem is there are spaces missing where sentences end so that some words are merged as one in some places.

I have tried using Replace of vbLf and vbCr but I am having problems understanding the range requirement for the text Range function
( my Dim statement for the text is :

Dim docText As String
docText = ActiveDocument.Content.Text

whereas to Insert a Replace command, I need a Range for the

Range.Replace vbCR, " " line

and I am unsure how to link them up

Does anyone have any idea how to merge the Replace command into the otherwise functioning script ?

Any advice greatly appreciated,

Picture to follow

Bob

 

[BobTheSpreadsheetBuilder]

attached is the text result with some words joined where I would like a space to be

 

[Macropod]

You need to replace the line/paragraph breaks in Word with a placeholder before pasting into Excel, then replace the placeholder in Excel with the Chr(10) line breaks.

For example:

Sub Demo()
' Note: A reference to the Microsoft Excel # Object Library is required, set via Tools|References in the Word VBE.
Application.ScreenUpdating = False
Dim xlApp As New Excel.Application, xlWkBk As Excel.Workbook
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Wrap = wdFindContinue
    .MatchWildcards = True
    .Forward = True
    .Format = False
    .Text = "[^13^l]"
    .Replacement.Text = Chr(182)
    .Execute Replace:=wdReplaceAll
  End With
  .Copy
End With
ActiveDocument.Undo
'Start Excel
With xlApp
  'Add a workbook
  Set xlWkBk = .Workbooks.Add
  With xlWkBk.Sheets(1)
  'Paste the data
    .Paste 'Destination:=Range("A1")
    'Post-format the data
    On Error Resume Next
    .UsedRange.Replace What:=Chr(182), Replacement:=Chr(10)
    On Error GoTo 0
    .Rows.AutoFit
  End With
  .CutCopyMode = False
  .Visible = True
End With
Application.ScreenUpdating = True
End Sub

 

[BobTheSpreadsheetBuilder]

i will test this shortly and let you know.

Thank you so much for your efforts - i really appreciate this