VBA Macro - Copying selected range of cells to email and sending whilst Outlook is running.

John Strickland

New Member
Joined
Sep 30, 2020
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
Hi,

Hopefully somebody can help a complete amateur out:
I have created an order form to simplify an ordering process between 30 stores (with varying levels of I.T ability) and a HQ.
When the 'send weekly orders' button is pressed (with the assigned macro below) it copies the table (including formats) onto an email, completes the subject line based on some text and specific cell info and automatically sends. It also sorts column 'E' alphabetically prior to copying and sending. I have winged my way through the code so far with some research and copying with relative success. The issue I'm having is that the macro is trying to open the Outlook application which is already running and I receive the following error message: "Sorry we're having trouble opening Outlook. Only one version of Outlook can run at a time. Check to see if there is another version of Outlook running, or try restarting your computer."
If Outlook is closed the sheet works perfectly but I do not want to have to shut down outlook (which will always be running across the 30 computers) just to send the orders. Is there a line that can be added / or removed that only opens a new message within Outlook without starting the application. This is my current Macro:


VBA Code:
Sub esendtable()

If MsgBox("Are you sure you would like to send this weeks Customer Orders?", vbYesNo) = vbNo Then Exit Sub

Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object
Dim rng As Range

'Optimize Code
  Application.ScreenUpdating = False

'Store Range to a variable
  Set rng = Range("E9:E16")

'Clear Any prior sorting
  ActiveSheet.Sort.SortFields.Clear

'Sort Range Alphabetically (A-Z)
  rng.Sort Key1:=rng.Cells(1), Order1:=xlAscending, Header:=xlNo
   


Set outlook = CreateObject("Outlook.Application")
Set newEmail = outlook.CreateItem(0)


With newEmail
    .To = "Myemail.com"
    .CC = ""
    .BCC = ""
    .Subject = Range("C3").Value & "  Customer Orders   " & Range("C4").Value
    .Body = "Please see below this weeks customer orders. Thanks"
    .Display
   
    Set xInspect = newEmail.GetInspector
    Set pageEditor = xInspect.WordEditor
   
    Sheet1.Range("B8:H16").Copy
   
    pageEditor.Application.Selection.Start = Len(.Body)
    pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start
    pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)
    .Display
    .Send
    Set pageEditor = Nothing
    Set xInspect = Nothing
   
    MsgBox "Your Orders Have Been Sent"
End With
End Sub

-----------------

Many thanks in advance,
John
 
Last edited by a moderator:

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Replace this
VBA Code:
Set outlook = CreateObject("Outlook.Application")

by this
VBA Code:
    On Error Resume Next
    Set outlook = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If outlook Is Nothing Then
        Set outlook = CreateObject("Outlook.Application")
    End If
 
Upvote 0
Replace this
VBA Code:
Set outlook = CreateObject("Outlook.Application")

by this
VBA Code:
    On Error Resume Next
    Set outlook = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If outlook Is Nothing Then
        Set outlook = CreateObject("Outlook.Application")
    End If

Thanks for the reply, I have replaced as instructed but still receiving the same error message with Outlook running
 
Upvote 0
Although my screen flickers briefly, with the references according to the image below it works for me without any problem, regardless of whether Outlook is open or not.
The message you receive is probably caused by the restrictions placed on the network by your IT department. I don't have a solution.

ScreenShot121.png
 
Upvote 0
Have a look here it may well be related. Outlooks running status shouldn't make a difference.

 
Upvote 0

Forum statistics

Threads
1,223,914
Messages
6,175,351
Members
452,638
Latest member
Oluwabukunmi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top