[computerman29642]

So, we need automatic page breaks? Let me see what I can come up with.

[Rollin_Again]

Does the phrase "NEW FILE" actually appear between each new entry in the Word file or did you just place it there to help with your explantion?

Also, you will not be able to use the exact email address as the filename since it contains a special character (@)

You can always replace this symbol with an underscore or other character and save it that way. Would that work?

Regards,
Rollin

[Miss HK]

Hi Rollin_Again!


Basically, it's a 100 resumes all in one Word file that I need to split up into as many resumes.

The beginning of each resume is always the same:
From: bob@bobsaddress.com

I'd like to save by name or email id, changing @ to underscore isn't ideal cause i'll have to manually find and replace each file with @ again afterwards, could i just save each file with the name before @ ?

Here is an actual sample of the file:

From: bob@bobsaddress.com
Sent: Wednesday, October 31, 2007 2:04 PM
To: me@myemail.com
Subject: CANADA
----------------------------------------------------------------------
#11111111
----------------------------------------------------------------------
Name: kris
Address:
Email: kris@krismail.com
----------------------------------------------------------------------

CONTACT INFO
kris
kris@krismail.com
RESUME
#11111111
Resume
Text Missing


From: bob@bobsaddress.com
Sent: Wednesday, October 31, 2007 2:04 PM
To: me@myemail.com
Subject: DESIGN
----------------------------------------------------------------------
#88888888
----------------------------------------------------------------------
----------------------------------------------------------------------
Name: jane
Address
Email: jane@janemail.com
----------------------------------------------------------------------

CONTACT INFO
Jane
jane@janemail.com
RESUME
#88888888
Headline:
Text Missing
----------------------------------------------------------------------


From: bob@bobsaddress.com
Sent: Wednesday, October 31, 2007 2:04 PM
To: me@myemail.com


I tried modifying the code you created but I know nothing about VBS!

[slurpee55]

That is much more useful for practical work. So, you could insert a page break before every point where "From: bob" appears?

[Anne Troy]

First run this macro, which I recorded and main not be incredibly efficient, but should be fine for your purposes:

Sub MakeBreaks()
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "From: "
        .Replacement.Text = "DELIMITERFrom: "
        'Your delimiter is the word DELIMITER, above
        .Forward = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.HomeKey Unit:=wdStory
    Selection.Delete Unit:=wdCharacter, Count:=1
End Sub

Then use the word DELIMITER in this macro, to separate the files:

http://vbaexpress.com/kb/getarticle.php?kb_id=922

If you have questions or problems, ask Steve Lucas, who wrote the macro, at vbaexpress. He's a great guy.

[slurpee55]

Nice Anne, but all it does is give you a place to insert page breaks. That is just as easily accomplished with a variation of what I posted in #9

Replace "From: bob" with "^mFrom: bob" and you will have manual page breaks in front of every place that "From: bob" occurs
(The "^" means page break in "Word" and "m" means manual)

[Rollin_Again]

Try this macro. Make sure to ALWAYS save a backup copy of the original Word document before running any macro code on it.

Sub SplitEmails()

vPath = ActiveDocument.Path & "\"

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Text = "From:"

vFirstRecord = True

Do While Selection.Find.Execute = True

If vFirstRecord = False Then

Selection.MoveUp Unit:=wdLine, Count:=1
Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
Selection.Cut
Documents.Add DocumentType:=wdNewBlankDocument
Selection.Paste
Selection.HomeKey Unit:=wdStory

Do While Selection.Text <> "F"
Selection.Delete Unit:=wdCharacter, Count:=1
Loop

Selection.EndKey Unit:=wdLine, Extend:=wdExtend
vFrom = Replace(Left(Replace(Trim(Mid(Selection.Text, 6)), "@", "_"), Len(Replace(Trim(Mid(Selection.Text, 6)), "@", "_"))), Chr(11), "")
ActiveDocument.SaveAs (vPath & vFrom & ".doc")
ActiveDocument.Close
vFirstRecord = True

Else

vFirstRecord = False

End If

Loop

Selection.EndKey Unit:=wdLine, Extend:=wdExtend
vFrom = Replace(Left(Replace(Trim(Mid(Selection.Text, 6)), "@", "_"), Len(Replace(Trim(Mid(Selection.Text, 6)), "@", "_"))), Chr(11), "")
Selection.HomeKey Unit:=wdStory

Do While Selection.Text <> "F"
Selection.Delete Unit:=wdCharacter, Count:=1
Loop

ActiveDocument.SaveAs (vPath & vFrom & ".doc")
ActiveDocument.Quit

End Sub

Regards,
Rollin

[slurpee55]

Looks good, Rollin! I hope you are enjoying this nice warm winter!

[Miss HK]

Sadly it's not working error message: 4198

Debugger points to: ActiveDocument.SaveAs (vPath & vFrom & ".doc")

Am I doing something wrong?

[Rollin_Again]

Add the following line just before the line that is throwing the error and then tell us what the messagebox says. What version of MS Word are you using? The only other thing I can think of is that you are using Word 2007 which would require that you change the file extension from .doc to .docx or similar. I tested the code on my earlier version of Word and did not recieve any errors.

Msgbox(vPath & vFrom & ".doc")

Regards,
Rollin

[Miss HK]

Duh...

Actually I tried converting my file from docx to doc and changing the code .doc to .docx but it seems to always split the first cv and the i get the msg error.

When I entered the line as you advised I first get a box that says:

C:\Documents and Settings: User\My Documents\ filename\ route.xxxxx.com.doc

When I click OK it is followed by another box: Run Time Error '4198'

Command failed

And so only the first file has been split

[Rollin_Again]

Without an actual sample doc it will be hard to determine why the macro is not working. I copied and pasted the text from one of your previous posts straight into a new doc and resaved it before running the macro and it worked fine. If you want to send me a sample via email I'd be happy to take a look. Just replace any sensitive data and reduce the total size to include only about 5 or six entries.

Does the filename route.xxxxx.com.doc contain any special characters such as apostrophe or single quote mark?

When you get the runtime error it should give you the option to debug. Click debug and tell me which line of code is highlighted.


Rollin_Again at Hotmail dot com

[Rollin_Again]

OK I got your sample document you sent me via email. It looks like the reason the code was failing was because the FROM: line contains two special characters that cannot be used in the SaveAs filename. These special characters are the Tab character and the Carriage Return character. I have modified the code to replace these characters with nothing. Just add the following two lines of code before each of the two save commands (ActiveDocument.SaveAs)

vFrom = Replace(vFrom, Chr(9), "")
vFrom = Replace(vFrom, Chr(13), "")

Your final code should appear as it does below. Make sure that you ALWAYS maintain duplicate copies of documents prior to running any macros on them. Also, the document that you are running the macro on should also be saved locally to your disk instead of opening directly from an email and running the macro. If you open a document straight from your email and do not save to your hard disk the individual docs will be saved to the temp files directory where they may be lost after being written.

Sub SplitFiles()

vPath = ActiveDocument.Path & "\"

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Text = "From:"

vFirstRecord = True

Do While Selection.Find.Execute = True

If vFirstRecord = False Then

Selection.MoveUp Unit:=wdLine, Count:=1
Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
Selection.Cut
Documents.Add DocumentType:=wdNewBlankDocument
Selection.Paste
Selection.HomeKey Unit:=wdStory

Do While Selection.Text <> "F"
Selection.Delete Unit:=wdCharacter, Count:=1
Loop

Selection.EndKey Unit:=wdLine, Extend:=wdExtend
vFrom = Replace(Left(Replace(Trim(Mid(Selection.Text, 6)), "@", "_"), 

Len(Replace(Trim(Mid(Selection.Text, 6)), "@", "_"))), Chr(11), "")
vFrom = Replace(vFrom, Chr(9), "")
vFrom = Replace(vFrom, Chr(13), "")
ActiveDocument.SaveAs (vPath & vFrom & ".doc")
ActiveDocument.Close
vFirstRecord = True

Else

vFirstRecord = False

End If

Loop

Selection.EndKey Unit:=wdLine, Extend:=wdExtend
vFrom = Replace(Left(Replace(Trim(Mid(Selection.Text, 6)), "@", "_"), 

Len(Replace(Trim(Mid(Selection.Text, 6)), "@", "_"))), Chr(11), "")
vFrom = Replace(vFrom, Chr(9), "")
vFrom = Replace(vFrom, Chr(13), "")
Selection.HomeKey Unit:=wdStory

Do While Selection.Text <> "F"
Selection.Delete Unit:=wdCharacter, Count:=1
Loop

ActiveDocument.SaveAs (vPath & vFrom & ".doc")
Application.Quit

End Sub

Regards,
Rollin

[slurpee55]

sweet work, Rollin! hope it works!

[Miss HK]

Almost there thank you! I run the macro, and it seems to work, but I can't find the files, I'm not sure where they have been saved.