Good afternoon
I wonder if anyone can help me on this one?
I have a macro in Excel that generates a word doc in the form or a letter including importing a table and other variables. It does this by opening a template file adds the text and table etc, saves the doc on the shared drive as a new file name obtained from some cells in the excel sheet. This all works fine. What I am looking to do, is have another macro that will email the letter in full, with graphics and formatting as the body of an email in Outlook.
I have found and macro written by Ron Du Bruin I believe, that does this perfectly but only when I run it from Word. I would like this work when I click a button in my main Excel sheet. Any help on this would be much appreciated. Thanks in advance.
Here is Ron's macro:
Sub SendDocAsMail()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
Dim wdEditor As Word.Document
Set wdApp = CreateObject("Word.Application")
Set wdDoc = ActiveDocument
Set wdEditor = ActiveDocument
On Error Resume Next
'Start Outlook if it isn't running
Set oOutlookApp = GetObject("Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
End If
'Create a new message
Set oItem = oOutlookApp.CreateItem(olMailItem)
'Allow the user to write a short intro and put it at the top of the body
Dim msgIntro As String
msgIntro = InputBox("Write a short intro to put above your default " & _
"signature and current document." & vbCrLf & vbCrLf & _
"Press Cancel to create the mail without intro and " & _
"signature.", "Intro")
'Copy the open document
Selection.WholeStory
Selection.Copy
Selection.End = True
'Set the WordEditor
Dim objInsp As Outlook.Inspector
'Dim wdEditor As Word.Document
Set objInsp = oItem.GetInspector
Set wdEditor = objInsp.WordEditor
'Write the intro if specified
Dim i As Integer
If msgIntro = IsNothing Then
i = 1
'Comment the next line to leave your default signature below the document
wdEditor.Content.Delete
Else
'Write the intro above the signature
wdEditor.Characters(1).InsertBefore (msgIntro)
i = wdEditor.Characters.Count
wdEditor.Characters(i).InlineShapes.AddHorizontalLineStandard
wdEditor.Characters(i + 1).InsertParagraph
i = i + 2
End If
'Place the current document under the intro and signature
wdEditor.Characters(i).PasteAndFormat (wdFormatOriginalFormatting)
'Display the message
oItem.Display
'Clean up
Set oItem = Nothing
Set oOutlookApp = Nothing
Set objInsp = Nothing
Set wdEditor = Nothing
End Sub