How to extract / delete first word of each page?

[Jysquare]

Hello everyone,

First of all I'm a beginner in VBA so please be kind. Let me explain the situation.

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

Then I did (by looking on the net) a macro to split the result file in several others, 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.

Exemple : if I have a customer named Vbaexpress I would like to have a file named Facture_Vbaexpress.doc for it.

But I'm totally stuck on how to do that. I found nowhere how to select, extract and then delete this first word from my page.
Any help would be most welcome, 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

Thanks in advance. By the way I'm using Office 2007.
js

[akuini]

I assume the first word of each page is the customer's name and the name is just one word.
I changed your code a bit, just try it:



Sub DecouperDocument()
Dim theName As String
Dim Rng As Range
Application.Browser.Target = wdBrowsePage
Selection.HomeKey unit:=wdStory
For i = 1 To ActiveDocument.BuiltInDocumentProperties("Number of Pages")

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

Documents.Add
Selection.Paste
Selection.TypeBackspace

'code to select, extract and then delete the first word
'of the new document
Selection.HomeKey unit:=wdStory
Set Rng = Selection.Range
Rng.MoveEnd unit:=wdWord, Count:=1
theName = RTrim(Rng)
Rng.Delete


ChangeFileOpenDirectory "D:\from D\coba\"
ActiveDocument.SaveAs FileName:="Facture_" & theName & ".doc"
ActiveDocument.Close

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

[macropod]

Try:
Sub DecouperDocument()
Application.ScreenUpdating = False
Dim InDoc As Document, OutDoc As Document, i As Long
Dim RngOut As Range, RngNm As Range, StrNm As String
Set InDoc = ActiveDocument
With InDoc
Set RngOut = ActiveDocument.Range(0, 0)
For i = 1 To .ComputeStatistics(wdStatisticPages)
Set RngOut = RngOut.GoTo(What:=wdGoToPage, Name:=i)
Set RngOut = RngOut.GoTo(What:=wdGoToBookmark, Name:="\page")
RngOut.Copy
Set OutDoc = Documents.Add
With OutDoc
.Range.Paste
.Characters.Last.Delete
Set RngNm = .Paragraphs.First.Range
RngNm.End = RngNm.End - 1
StrNm = RngNm.Text
.Paragraphs.First.Range.Delete
.SaveAs FileName:="C:\test\Facture_" & StrNm & ".doc"
.Close
End With
Next i
.Close SaveChanges:=wdDoNotSaveChanges
End With
Set RngOut = Nothing: Set RngNm = Nothing
Set InDoc = Nothing: Set OutDoc = Nothing
Application.ScreenUpdating = True
End Sub
With this code, multi-word names can be managed. it should also be much faster.