vbams-wordextractword-2007

How to extract / delete first word of each page?


I did a mailmerge to create dynamic word pages with customer information.

Then I did (by looking on the net) a macro to split the result file into several pages, each page being saved as one file.

Now I'm looking to give those files some names containing customer info. I googled that and I think the (only?) way is to create a mergefield with that info, at the very beginning of the page, then extract and delete it from the page with a macro to put it in file names.

Example: If I have a customer named Stackoverflow I would like to have a file named Facture_Stackoverflow.doc.

I found nowhere how to select, extract and then delete this first word from my page.

Here is my "splitting macro", which currently names the files just with an incremented ID:

Sub DecouperDocument()
    Application.Browser.Target = wdBrowsePage

    For i = 1 To ActiveDocument.BuiltInDocumentProperties("Number of Pages")

        ActiveDocument.Bookmarks("\page").Range.Copy

        Documents.Add
        Selection.Paste

        Selection.TypeBackspace
        ChangeFileOpenDirectory "C:\test\"
        DocNum = DocNum + 1
        ActiveDocument.SaveAs FileName:="Facture_" & DocNum & ".doc"
        ActiveDocument.Close

        Application.Browser.Next
    Next i
    ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub

Solution

  • The function below will enable you to extract the first word (and optionally remove it) of a Word document.

    Public Function GetFirstWord(Optional blnRemove As Boolean = True) As String
    
        Dim rng As Range
        Dim intCharCount As Integer
        Dim strWord As String
    
        With ThisDocument
            Set rng = .Characters(1)
    
            intCharCount = rng.EndOf(wdWord, wdMove)
    
            With .Range(0, intCharCount - 1)
                strWord = .Text
                If blnRemove Then
                    .Delete
                End If
            End With
        End With
    
        GetFirstWord = strWord
    
    End Function
    

    I hope this helps.