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:

Some videos you may like

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,089
Office Version
  1. 2013
Platform
  1. Windows
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
 

John Strickland

New Member
Joined
Sep 30, 2020
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
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
 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,089
Office Version
  1. 2013
Platform
  1. Windows
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
 

daverunt

Well-known Member
Joined
Jul 9, 2009
Messages
1,855
Office Version
  1. 2013
Platform
  1. Windows
Have a look here it may well be related. Outlooks running status shouldn't make a difference.

 

John Strickland

New Member
Joined
Sep 30, 2020
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
Thanks for the input, all sorted - issue with my laptop and Anti-Virus Software
 

Watch MrExcel Video

Forum statistics

Threads
1,111,429
Messages
5,540,766
Members
410,524
Latest member
vkshinde
Top