PDA

View Full Version : Merge saved as seprate file?



kschreiber
11-28-2007, 09:03 AM
I need the mail merge to a seprate file explained so I can understand ...I do not do the macro thing so :banghead: very slowly please! I can do the merge thing I get a very one document on seprate pages I have the name of the file on the top of the merged document but I don't know how to get it to save it as a new file. I can send you an example I hope you can help!! thanks

k

TonyJollans
11-28-2007, 10:15 AM
Glad you managed to post :)

Now, I'm afraid, I don't really understand what you're saying. What do you mean by merging to a separate file and what is it about it that you don't understand? What exactly can't you do? And what do you want to do in code?

kschreiber
11-29-2007, 01:37 AM
In a previous post it was called Mail Merge - Doc Save Name, but the person posting was able to provide you with page of code and you then tweaked the code to perform the wanted task. I don?t know how to do that, but I want to be able to after the merge is completed. I need a macro that would separate and name the merged document into separate files. I have attached a sample of the merge document, each teen needs to have a copy of ILS training for their file. I know a macro would be able to perform this task right now I have to cut and paste each sheet then do a save as the name and date. I hope I have explained what I need to be able to do. I have attached the merge page I am hoping you can help thanks Kathy

TonyJollans
11-29-2007, 06:28 AM
What I did before took the file name from a merge field and saved the merged documents one by one as they were merged.

If I understand correctly you already have the merged document. If that's the case (or even if it isn't), then where will the file name come from? The date I can work out, but what about the 'name'?

Splitting the document either during the merge or afterwards isn't especially difficult but you need to specify the file names somewhere.

kschreiber
11-29-2007, 08:52 PM
I was starting with a merged document because that's as far as I am able to automate.. then what I have to do is copy one page of the merged document then open a new blank document.. paste ..then do a save as ..word then uses the first line of the merged document which contains the fields client name and date of contact then I close that file and then continue on until the end. I have copied and pasted a Macro from MVP Doug Robbins the purple font indicates code I do not understand. Am not sure id I am supposed put my own information in there? for example I do not have a D drive .....Docname = "D:\My Documents\Test\Merge\" & sName & ".doc"

I know this can't be that hard! But its making me crazy! I have tried to find instruction books that are very basic so I could figure it out but I not had a lot of luck.


Sub SplitMergeLetter()
' splitter Macro modified to save individual letters with
' information from data source. The filename data must be added to the top of the merge letter - see web article.
Selection.EndKey Unit:=wdStory
Letters = Selection.Information(wdActiveEndSectionNumber)
Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters
Application.ScreenUpdating = False
With Selection
.HomeKey Unit:=wdStory
.EndKey Unit:=wdLine, Extend:=wdExtend
.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
End With
sName = Selection
Docname = "D:\My Documents\Test\Merge\" & sName & ".doc"
ActiveDocument.Sections.First.Range.Cut
Documents.Add
With Selection
.Paste
.HomeKey Unit:=wdStory
.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
.Delete
End With
ActiveDocument.SaveAs FileName:=Docname, _
FileFormat:=wdFormatDocument
ActiveWindow.Close
Counter = Counter + 1
Application.ScreenUpdating = True
Wend
End Sub

TonyJollans
11-30-2007, 06:05 AM
Looking at the code, the first thing to notice is that it works with the Selection. The Selection is the what is selected with the cursor on the screen. This is generally not advised for performance reasons, if no other, and it is generally better to use a Range object, which can represent any part of a document without affecting the screen display.

Now, working through the code, ...

Selection.EndKey Unit:=wdStory
This line simply positions the cursor at the end of the document


Letters = Selection.Information(wdActiveEndSectionNumber)
This gets the section number at the cursor position.
This will be the same as the number of sections in the document.


Selection.HomeKey Unit:=wdStory
This puts the cursor at the start of the document

Each merged record in your Document is created as a separate Section by the Merge; the number of sections in the document, therefore, is the same as the number of merged records and will provide a count for use later in the code. The number of sections can be got more easily, simply with:Letters = ActiveDocument.Sections.CountThe above line does not position the cursor at the start of the document but, as you will see shortly, this is repeated and not necessary anyway.

Counter = 1
This just initialises a counter

While Counter < Letters
This is the start of a loop


Application.ScreenUpdating = False
This prevents constant screen updates when messing with the Selection.
This will not be needed if the Selection is not used.

The While ... Wend construct is deprecated, and a better way to control the loop is to use a For ... Next construct; the code for this is:
For Counter = 1 to LettersNext is:

With Selection
This says you want to work with the Selection until further notice

.HomeKey Unit:=wdStory
Here again the cursor is positioned at the start of the document.
It is because it is here that it isn't also needed earlier
But, as you are no longer using the Selection, it won't be needed at all.

.EndKey Unit:=wdLine, Extend:=wdExtend
This moves the cursor to the end of the line, and extends it.
In other words, the first line of the document is selected.

.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
This moves the cursor one character to the left, still 'extending' the Selection.
In other words, remove the paragraph mark from the Selection.

End With
This is the further notice that you are no longer working with the Selection.

sName = Selection
This sets the variable, sName, to the text in the Selection.

To use a Range instead of the Selection, the above can be replaced by the following code, which also deletes the first paragraph after it has extracted the name from it:Dim myRange As Word.Range
Set myRange = ActiveDocument.Paragraphs(1).Range
myRange.MoveEnd wdCharacter, -1
sName = myRange.Text
myRange.Paragraphs(1).Range.DeleteNow it starts to get interesting:

Docname = "D:\My Documents\Test\Merge\" & sName & ".doc"
This sets the variable, Docname, to the concatenated string of the hard-coded path, the text from the document, and the ".doc" suffix.
If you want the documents in a different place, hard code a different path here.

ActiveDocument.Sections.First.Range.Cut
This removes the first section from the Document and places it on the clipboard.


These lines don't change, so you still have:Docname = "D:\My Documents\Test\Merge\" & sName & ".doc"
ActiveDocument.Sections.First.Range.Cut
Documents.Add
This opens a new, blank, Document.

With Selection
You are going to work with the Selection again.
But note that this is not the same Selection you had before because now you have opened a new Document and the Selection is within it.


.Paste
This pastes what you previously copied to the clipboard


.HomeKey Unit:=wdStory
As before, this moves the cursor to the start of the (new) Document which now contains the pasted content.


.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
This moves the Selection down a line, selecting the first paragraph.
It does assume thatthe paragraph is wholly contained in a single line.


.Delete
This deletes the selected first paragraph.


End With
You've done with the Selection for the moment.

To replace all the above is fairly simple. You'll remember that the new code has already deleted the paragraph containing the file name, and that you are going to be working with Ranges, not the Selection, so you have just:Documents.Add
ActiveDocument.Range.PasteGetting towards the end, now ...

ActiveDocument.SaveAs FileName:=Docname, _
FileFormat:=wdFormatDocument
This saves the active document (in Word Document format), using the DocName you built earlier.

ActiveWindow.Close
This closes the current window - and the document with it.
It is more normal to close the Document rather than the window, so these two lines can become:ActiveDocument.SaveAs FileName:=Docname, FileFormat:=wdFormatDocument
ActiveDocument.CloseIf you look at these lines and the previous block, you will see that they all use the ActiveDocument, and so they could be combined in a With block. Further, the Document they are working with, the Active Document, is the one just added and it can be used directly:With Documents.Add
.Range.Paste
.SaveAs FileName:=Docname, FileFormat:=wdFormatDocument
.Close
End WithLastly
Counter = Counter + 1
This increments the loop counter. as this is now done in the For ... Next construct, it is not needed here.

Application.ScreenUpdating = True
You no longer set this to False at the beginning so no loger need to set it to True here.

Wend
The end of the Loop is now a Next statement, so the last part of the code is simply that.

Putting it all together, you get
Letters = ActiveDocument.Sections.Count
For Counter = 1 to Letters
Dim myRange As Word.Range
Set myRange = ActiveDocument.Paragraphs(1).Range
myRange.MoveEnd wdCharacter, -1
sName = myRange.Text
myRange.Paragraphs(1).Range.Delete
Docname = "D:\My Documents\Test\Merge\" & sName & ".doc"
ActiveDocument.Sections.First.Range.Cut
With Documents.Add
.Range.Paste
.SaveAs FileName:=Docname, FileFormat:=wdFormatDocument
.Close
End With
Next

I've just typed this in (and that took long enough :)) and not tested it so I may have made a typo or two, and it could be tidied up a bit more but I hope it gives you a start.

kschreiber
11-30-2007, 03:13 PM
Thanks bunches! You are a sweetie! I did the path changes and tried to run the macro it gives me ..5152 error and when I do debug ..it gives me this.. .SaveAs FileName:=Docname, FileFormat:=wdFormatDocument ...as the yellow highlighted field


Suggestions???

TonyJollans
11-30-2007, 04:17 PM
I think that means your filename is invalid.

While the line is highlighted yellow, ..

press Ctrl+G to go to the immediate window
Type "?Docname" (without the quotes)
Press Enter and it will print out the value of DocName
Check it to make sure it is correct - or, I hope, to find the error in it.

kschreiber
11-30-2007, 07:01 PM
?docname
C:\My Documents\Test\Merge\.doc

Then what??

TonyJollans
12-01-2007, 01:59 AM
You have a slash too many.

...Merge\.doc should be ...Merge.doc

TonyJollans
12-01-2007, 02:02 AM
More likely, actually, is that the document name is missing. Perhaps the filename isn't the first paragraph in the merge. Can you post a sample document (you should be able to now, but you will need to zip it)?

kschreiber
12-01-2007, 12:31 PM
:clap: :whistle: Yea!!! Yiphee!!! It works!! :bow: I have an extra blank page when they split .....I have checked the format and I can't see why and it makes one blank file? ????

I am sorry but I don't know how to make the file a zip file???

TonyJollans
12-01-2007, 12:49 PM
If you don't have WinZip or WinRAR (or any other zip utility) then it depends on your version of Windows but you can probably right click the file and select "Send to" and then select "Compressed (zipped) folder".

kschreiber
12-01-2007, 01:14 PM
I am just thrilled that this works!! And since you are so good, can you tell me if a macro can be written to also send each of those separated merged files as an attachment in Outlook?? : pray2:

TonyJollans
12-01-2007, 04:29 PM
I'm sure it can be done - well, Im pretty sure but the Object Model Guard will probably get in the way - it's just a prompt that you have to answer and there are ways of auto-answering it if need be. Anyway I'll see if I can find some code tomorrow.

Where does the e-mail address come from?

TonyJollans
12-02-2007, 01:27 PM
I had a quick look but couldn't see any code so I've written this. Please remember that Outlook is not my speciality, but this appears to work.

Basic code is:

Set appOL = CreateObject("Outlook.Application")
Set E_Mail = appOL.CreateItem(olMailItem)
Set Needed = E_Mail.GetInspector

E_Mail.Recipients.Add User@Example.com
E_Mail.Subject = "Yet Another Test"
E_Mail.Attachments.Add "C:\Path\And\Name\To\Document.doc"
E_Mail.Send

Set Needed = Nothing
Set E_Mail = Nothing
Set appOL = Nothing


It's worth pointing out that you can only have one instance of Outlook and, if you already have Outlook running, the CreateObject will simply attach you to it.

In a quick test I found that I needed to create an Inspector to make it work if Outlook wasn't already running - hence the Set Needed line.

I don't know where you plan to get the e-mail addresses from, or when, so I'm not sure how to adapt it for you. If you can get it, or derive it, in the earlier code, this might work:

Sub CreateDocAndEMail()
Dim myRange As Word.Range
Dim DocName As String

Dim appOL 'As Outlook.Application
Dim E_Mail 'As Outlook.MailItem
Dim Needed 'As Outlook.Inspector

Set appOL = CreateObject("Outlook.Application")

Letters = ActiveDocument.Sections.Count
For Counter = 1 To Letters
Set myRange = ActiveDocument.Paragraphs(1).Range
myRange.MoveEnd wdCharacter, -1
DocName = "D:\My Documents\Test\Merge\" & myRange.Text & ".doc"
myRange.Paragraphs(1).Range.Delete
ActiveDocument.Sections.First.Range.Cut
With Documents.Add
.Range.Paste
.SaveAs FileName:=DocName, FileFormat:=wdFormatDocument
.Close
End With

Set E_Mail = appOL.CreateItem(olMailItem)
Set Needed = E_Mail.GetInspector
E_Mail.Recipients.Add "User@Example.com"
E_Mail.Subject = "ILS Training Document"
E_Mail.Attachments.Add DocName
E_Mail.Send

Next
Set Needed = Nothing
Set E_Mail = Nothing
Set appOL = Nothing
End Sub

kschreiber
12-02-2007, 04:55 PM
Sorry I didn't notice your question about where the email address comes from it is in a excel workbook with the other merge info. If there is a email address available it is on the contact sheet

kschreiber
12-02-2007, 05:00 PM
I know you should be about ready to pull your hair!! but I need to ask do I run the macro after I do the merge like I do the other one?

TonyJollans
12-02-2007, 05:18 PM
Try this - instead of the original.


Sub CreateDocAndEMail()
Dim myRange As Word.Range
Dim DocName As String
Dim MailTo As String

Dim appOL 'As Outlook.Application
Dim E_Mail 'As Outlook.MailItem
Dim Needed 'As Outlook.Inspector

Set appOL = CreateObject("Outlook.Application")

Letters = ActiveDocument.Sections.Count
For Counter = 1 To Letters
Set myRange = ActiveDocument.Paragraphs(1).Range
myRange.MoveEnd wdCharacter, -1
DocName = "D:\My Documents\Test\Merge\" & myRange.Text & ".doc"
myRange.Paragraphs(1).Range.Delete
ActiveDocument.Sections.First.Range.Cut
With Documents.Add
.Range.Paste
Set myRange = .Paragraphs(.Paragraphs.Count - 2).Range
myRange.MoveEnd wdCharacter, -1
If InStr(myRange.Text, "@") Then
MailTo = myRange.Text
Else
MailTo = ""
End If
.SaveAs FileName:=DocName, FileFormat:=wdFormatDocument
.Close
End With

If MailTo <> "" Then
Set E_Mail = appOL.CreateItem(olMailItem)
Set Needed = E_Mail.GetInspector
E_Mail.Recipients.Add "User@Example.com"
E_Mail.Subject = "ILS Training Document"
E_Mail.Attachments.Add DocName
E_Mail.Send
End If

Next
Set Needed = Nothing
Set E_Mail = Nothing
Set appOL = Nothing
End Sub

It will save each document in turn and, if there is an email address, email the saved document to it. You might want to add something to tell you about those it hasn't been able to mail.

TonyJollans
12-02-2007, 05:19 PM
Oops! - replace User@Example.com with MailTo

kschreiber
12-02-2007, 09:26 PM
I get an error message when I try to run
debug
.SaveAs FileName:=DocName, FileFormat:=wdFormatDocument

?docname
F:\My Documents\Test\Merge Eagle Hawk Angeleah Rose 10/15/2007 .doc
It looks alright?

TonyJollans
12-03-2007, 12:22 AM
A Filename cannot contain a / character.

If they are in your document and there's nothing you can do about it they can be removed in the code (or changed to another character, a hyphen perhaps).

kschreiber
12-03-2007, 09:04 AM
no its not in the file name so it's in the macro I cut and pasted it and then changed the drive I will retry now that I am home

kschreiber
12-03-2007, 09:06 AM
oh its in the date eh?

kschreiber
12-03-2007, 09:22 AM
OK I changed the date and tried to run it and I get
ambiguous name detected CreateDocnameAndEmail

and yes it would be great if did something to note no email address

TonyJollans
12-03-2007, 10:06 AM
Ambiguous name probably means you have two macros with the same name.

TonyJollans
12-03-2007, 10:08 AM
Perhaps you could change ..
If MailTo <> "" Then
to

If MailTo = "" Then
Msgbox "Document " & DocName & " not e-mailed. No mail id found"
Else

If you may have lots you may want something more sophisticated.

fumei
12-03-2007, 10:36 AM
I thought ambiguous always meant there are two identical names. Although why the text of the error does not simply SAY that, I don't know.

...it is...ummmm, ambiguous.

kschreiber
12-03-2007, 12:25 PM
I still get and I can find the error .. I removed the / and made sure the path is correct any ideas?

.SaveAs FileName:=DocName, FileFormat:=wdFormatDocument

TonyJollans
12-03-2007, 12:28 PM
Yes I have never understood the ambiguity as opposed to the duplicity.

TonyJollans
12-03-2007, 12:28 PM
What is the DocName now?

kschreiber
12-03-2007, 12:31 PM
"C:\Documents and Settings\Administrator\My Documents\Test " & myRange.Text & ".doc"

TonyJollans
12-03-2007, 12:34 PM
Yes, but what value does myRange.text have when it errors?

kschreiber
12-03-2007, 06:17 PM
I thought I should clarify when try to run macro I get this error message
Run-time error 4198 command failed

When I do debug I get this highlighted yellow
.SaveAs FileName:=DocName, FileFormat:=wdFormatDocument


?docname
C:\Documents and Settings\Administrator\My Documents\Test Eagle Hawk Angeleah Rose Oct 15, 2007.doc

So I have checked path, seems correct.
What else should I look at ?

TonyJollans
12-03-2007, 10:45 PM
I hate "Command failed" messages - they give you nothing to go on.

Do you have authority to write to Administrator files?

kschreiber
12-04-2007, 06:39 AM
Yes it is the same file name used for the first macro and that worked

TonyJollans
12-04-2007, 08:05 AM
So the file already exists? That could explain it.

kschreiber
12-04-2007, 08:26 AM
What I meant is I used the same folders as the other one the folders are empty so the file does not already exist. I made the folders so it would have some place to put it

kschreiber
12-04-2007, 09:06 AM
Yes, but what value does myRange.text have when it errors?
myRange.Text
When it gives the error message is the email address

TonyJollans
12-04-2007, 09:34 AM
But you don't want to be saving as the e-mail address. @ is not a valid character in a filename which will be why it fails.

Can you post exactly the code you are using when it fails?

kschreiber
12-04-2007, 09:41 AM
ub CreateDocAndEMail()
'
' create Macro
' Macro created 12/4/2007 by Kathy Schreiber
Dim myRange As Word.Range
Dim DocName As String
Dim MailTo As String

Dim appOL 'As Outlook.Application
Dim E_Mail 'As Outlook.MailItem
Dim Needed 'As Outlook.Inspector

Set appOL = CreateObject("Outlook.Application")

Letters = ActiveDocument.Sections.Count
For Counter = 1 To Letters
Set myRange = ActiveDocument.Paragraphs(1).Range
myRange.MoveEnd wdCharacter, -1
DocName = "C:\Documents and Settings\Administrator\My Documents\Test\Merge " & myRange.Text & ".doc"
myRange.Paragraphs(1).Range.Delete
ActiveDocument.Sections.First.Range.Cut
With Documents.Add
.Range.Paste
Set myRange = .Paragraphs(.Paragraphs.Count - 2).Range
myRange.MoveEnd wdCharacter, -1
If InStr(myRange.Text, "@") Then
MailTo = myRange.Text
Else
MailTo = ""
End If
.SaveAs FileName:=DocName, FileFormat:=wdFormatDocument
.Close
End With

If MailTo = "" Then
MsgBox "Document " & DocName & " not e-mailed. No mail id found"
Set E_Mail = appOL.CreateItem(olMailItem)
Set Needed = E_Mail.GetInspector
E_Mail.Recipients.Add "MailTo"
E_Mail.Subject = "ILS Training Document"
E_Mail.Attachments.Add DocName
E_Mail.Send
End If

Next
Set Needed = Nothing
Set E_Mail = Nothing
Set appOL = Nothing

End Sub

TonyJollans
12-04-2007, 10:32 AM
Just glancing at this, you set DocName to:

"C:\Documents and Settings\Administrator\My Documents\Test\Merge " & myRange.Text & ".doc"

when myRange has a value of the first paragraph in the document. I'm afraid I'm losing track of what that might contain.

To be sure what you are trying to do, can you add an extra line and run it again and post back with the result?

Immediately before the .SaveAs line, add this line:

Debug.Print DocName

This will output the value of DocName to the Immediate Window. Can you then cut and paste it and post it here?

kschreiber
12-04-2007, 10:33 AM
I redid the macro I noticed my changes to the code were not staying changed so I put the macro in the global templete

the code myRange.Text is correct here but I still get the error message and the following is hightlighted

.SaveAs FileName:=DocName, FileFormat:=wdFormatDocument

?docname
C:\Documents and Settings\Administrator\My Documents\Contact\Merge Haskell David November 15, 2007 .doc


Sub CreateDocAndEMail()
Dim myRange As Word.Range
Dim DocName As String
Dim MailTo As String

Dim appOL 'As Outlook.Application
Dim E_Mail 'As Outlook.MailItem
Dim Needed 'As Outlook.Inspector

Set appOL = CreateObject("Outlook.Application")

Letters = ActiveDocument.Sections.Count
For Counter = 1 To Letters
Set myRange = ActiveDocument.Paragraphs(1).Range
myRange.MoveEnd wdCharacter, -1
DocName = "C:\Documents and Settings\Administrator\My Documents\Contact\Merge " & myRange.Text & ".doc"
myRange.Paragraphs(1).Range.Delete
ActiveDocument.Sections.First.Range.Cut
With Documents.Add
.Range.Paste
Set myRange = .Paragraphs(.Paragraphs.Count - 2).Range
myRange.MoveEnd wdCharacter, -1
If InStr(myRange.Text, "@") Then
MailTo = myRange.Text
Else
MailTo = ""
End If
.SaveAs FileName:=DocName, FileFormat:=wdFormatDocument
.Close
End With

If MailTo <> "" Then
Set E_Mail = appOL.CreateItem(olMailItem)
Set Needed = E_Mail.GetInspector
E_Mail.Recipients.Add "MailTo"
E_Mail.Subject = "ILS Training Document"
E_Mail.Attachments.Add DocName
E_Mail.Send
End If

Next
Set Needed = Nothing
Set E_Mail = Nothing
Set appOL = Nothing
End Sub

TonyJollans
12-04-2007, 10:36 AM
Well that should be OK assuming the folder exists.

kschreiber
12-04-2007, 10:42 AM
?docname
C:\Documents and Settings\Administrator\My Documents\Contact\Merge Haskell David November 15, 2007 .doc

kschreiber
12-04-2007, 10:43 AM
The path and file name come from the address line in the computer

TonyJollans
12-04-2007, 10:56 AM
On the face of it, it looks like it should be working.

Just to be sure it's not a permissions or other system-related problem, after it fails can you manually try and save the document in the same place and with the same name.

kschreiber
12-04-2007, 11:14 AM
I can save it to that file manully. I have attached the file

TonyJollans
12-04-2007, 12:34 PM
It could be the tab.

Try changing ...


DocName = "C:\Documents and Settings\Administrator\My Documents\Contact\Merge " & myRange.Text & ".doc"



to


DocName = "C:\Documents and Settings\Administrator\My Documents\Contact\Merge " _
& replace(myRange.Text,vbtab,"") & ".doc"

kschreiber
12-04-2007, 12:46 PM
I never thought would be glad for a error message! at least it is a different one! now it says
Run time error 5941
the requested member of the collection does not exist

debug Set myRange = .Paragraphs(.Paragraphs.Count - 2).Range

TonyJollans
12-04-2007, 01:08 PM
An empty page?

You need to code for any situation you may encounter. From what little I know, this surprises me but, if it can happen, then change ..

Set myRange = .Paragraphs(.Paragraphs.Count - 2).Range
myRange.MoveEnd wdCharacter, -1
If InStr(myRange.Text, "@") Then
MailTo = myRange.Text
Else
MailTo = ""
End If

to


if .Paragraphs.Count > 2 then
Set myRange = .Paragraphs(.Paragraphs.Count - 2).Range
myRange.MoveEnd wdCharacter, -1
If InStr(myRange.Text, "@") Then
MailTo = myRange.Text
Else
MailTo = ""
End If

Else
MailTo = ""
End If

kschreiber
12-04-2007, 02:16 PM
End with without with

Here is what I have

Sub CreateDocAndEMail()
'
' CreateDocAndEMail()Macro
' Macro created 12/4/2007 by Kathy Schreiber
'
Dim myRange As Word.Range
Dim DocName As String
Dim MailTo As String

Dim appOL 'As Outlook.Application
Dim E_Mail 'As Outlook.MailItem
Dim Needed 'As Outlook.Inspector

Set appOL = CreateObject("Outlook.Application")

Letters = ActiveDocument.Sections.Count
For Counter = 1 To Letters
Set myRange = ActiveDocument.Paragraphs(1).Range
myRange.MoveEnd wdCharacter, -1
DocName = "C:\Documents and Settings\Administrator\My Documents\Contact\Merge " _
& Replace(myRange.Text, vbTab, "") & ".doc"
myRange.Paragraphs(1).Range.Delete
ActiveDocument.Sections.First.Range.Cut
With Documents.Add
.Range.Paste
If .Paragraphs.Count > 2 Then
Set myRange = .Paragraphs(.Paragraphs.Count - 2).Range
myRange.MoveEnd wdCharacter, -1
If InStr(myRange.Text, "@") Then
MailTo = myRange.Text
Else
MailTo = ""
End If
.SaveAs FileName:=DocName, FileFormat:=wdFormatDocument
.Close
End With
If MailTo = "" Then
MsgBox "Document " & DocName & " not e-mailed. No mail id found"
Else: Set E_Mail = appOL.CreateItem(olMailItem)
Set Needed = E_Mail.GetInspector
E_Mail.Recipients.Add "User@Example.com"
E_Mail.Subject = "ILS Training Document"
E_Mail.Attachments.Add DocName
E_Mail.Send
End If

Next
Set Needed = Nothing
Set E_Mail = Nothing
Set appOL = Nothing
End Sub

kschreiber
12-04-2007, 02:20 PM
.SaveAs FileName:=DocName, FileFormat:=wdFormatDocument
.Close
End With...... is where the debug stops

TonyJollans
12-04-2007, 02:32 PM
You haven't included the last part of the code I posted. The Else .. End If.

kschreiber
12-04-2007, 03:05 PM
YIPHEE! It did it!!! :mbounce:

It send emails to 'User@Example.com' how do I get it to email the address on the document? Does the email address need to be a hyperlink?

TonyJollans
12-04-2007, 04:52 PM
Change E_Mail.Recipients.Add "User@Example.com"
to E_Mail.Recipients.Add MailTo

kschreiber
12-04-2007, 05:09 PM
Yew Doggies!!! it works!! :bigdance2 One last thing I promise! the email attachment has 2 pages the saved document has two also but the original has one ?? any ideas?

TonyJollans
12-05-2007, 12:03 AM
You need to remove the section break but you need to be careful that you don't disturb the code for picking up the e-mail address. This should be alright - immediately before the .SaveAs, add this line:

.Range.Characters.Last.Previous.Delete

kschreiber
12-05-2007, 06:46 PM
Thank you! You're the greatest!!!! :beerchug:

kschreiber
12-10-2007, 12:43 PM
Bet you thought I was gone !! and now that I'm back you'd like to :bonk:

The macro works great!! Does just what I wanted it to!
But I have another problem! The server doesn't allow me to access Outlook that way. Because I can from the merged new created docment copy the email address then go to file and send as an attachment then paste the email address in the send to address and send?? Well? What do you think??

TonyJollans
12-10-2007, 01:04 PM
I'm not sure I understand the problem. What error do you get?