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