Email Word Document via VBA code

[dprayner]

I am trying to email a picture in the body of a Word Document. I need to code the equivalent to File -> Send To -> Mail Recipient. This is my code so far:

Private Sub cmdSubmit_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim Counter As Integer
Dim FileName As String
Dim bStarted As Boolean
Dim User As String
Dim AppPath As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
AppPath = ActiveDocument.FullName
User = Environ("USERNAME")
FileName = "c:\Documents and Settings\" & User & "\My Documents\Form.Doc"
Application.DisplayAlerts = False
ActiveDocument.SaveAs FileName
With OutMail
.To = "someone@somewhere.com"
.Cc = "CCSomeone"
.Body = ActiveDocument.Content
.Subject = "Subject"
ActiveDocument.SaveAs FileName
WordBasic.SendKeys "(%{1068})"
Selection.Paste
With ActiveDocument.InlineShapes(0)
.ScaleHeight = 100
.ScaleWidth = 100
End With
.Send
End With
If bStarted Then
OutApp.Quit
End If
'Clean up
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

My problem is that it emails fine, except the picture in the body of the Document doesn't come through in the body of the email message. I know the ActiveDocument.Content is supposed to be used for unformatted text, but I was hoping it would retain the picture. Any suggestions? DAVE

 

[fumei]

Why do you want to email the contents of the document in the body of the email? What is wrong with simply emailing the document?

Gerry

 

[dprayner]

Hi Gerry. Nothing wrong with emailing the Document if I knew how. I'm sure I could set the SendKeysto accomplish this, but I'm not sure how to set the To, Subject, Cc, etc.
Any suggestions? DAVE

 

[PHV]

Straight from the Outlook VBA help:
Sub AddAttachment()
Dim myOlApp As New Outlook.Application
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Set myItem = myOlApp.CreateItem(olMailItem)
Set myAttachments = myItem.Attachments
myAttachments.Add "C:\Test.doc", _
olByValue, 1, "Test"
myItem.Display
End Sub

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[fumei]

And there you go.

Gerry

 

[dprayner]

Hi people.

I have been using this code which I have had minor success with:

Private Sub cmdSubmit_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim Counter As Integer
Dim FileName As String
Dim bStarted As Boolean
Dim User As String
Dim AppPath As String
Dim Prompt, Prompt2, Answer, Answer2
Set OutApp = CreateObject("Word.Application")
Set OutMail = ActiveDocument.MailEnvelope.Item
'Set OutMail = OutApp.CreateItem(0)
AppPath = ActiveDocument.FullName
User = Environ("USERNAME")
FileName = "c:\Documents and Settings\" & User & "\My Documents\TForm.Doc"
Application.DisplayAlerts = False
ActiveDocument.SaveAs FileName
With OutMail
.To = "someone@somewhere.com"
.Cc = User
.Body = ActiveDocument.Content
.Subject = "Transfer form" 'Form name
ActiveDocument.SaveAs FileName

WordBasic.SendKeys "(%{1068})"
DoEvents
Prompt = "Do you want to submit this form?"
Answer = MsgBox(Prompt, vbInformation + vbOKCancel)
If Answer = vbOK Then
Selection.Paste
With ActiveDocument.InlineShapes(0)
.ScaleHeight = 100
.ScaleWidth = 100
End With
'WordBasic.SendKeys "%(fdms)"
.Send
Prompt2 = "Form submitted. Close this window now?"
Answer2 = MsgBox(Prompt2, vbInformation + vbOKCancel)
If Answer2 = vbOK Then
Unload Me
End If
End If
End With
If bStarted Then
OutApp.Quit
End If
'Clean up
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Unfortunately, I am coming up with some run-time errors. Any suggestion? DAVE