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

[John Strickland]

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:

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

 

[GWteB]

Replace this

Set outlook = CreateObject("Outlook.Application")

by this

    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]

Replace this

Set outlook = CreateObject("Outlook.Application")

by this

    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]

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.

 

[daverunt]

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

Only one version of Outlook?

Solution: This is the communication I put out to our folks, in-case anyone else lands here with the same questions.Several of our folks have

community.spiceworks.com

 

[John Strickland]

Thanks for the input, all sorted - issue with my laptop and Anti-Virus Software