Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations bkrike on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Add Start Outlook Session To VBA Code

Status
Not open for further replies.

tweek312

Technical User
Dec 18, 2004
148
US
This should be really simple for you pros but I have not been able to figure this one out.

All I need to do is to add code that will open an outlook session or use the current one.

Please dont change the code that i have already done. I know that theres probably a better way but what here works for me.

Thanks,
tW33k

Code:
Sub prep_everpt()

Dim ReturnValue As Integer
   ReturnValue = MsgBox("Are you sure you want to compile the report?", vbQuestion + vbOKCancel, "Compile Report")
   Select Case ReturnValue
   Case vbOK
      
   Case vbCancel
      Exit Sub
   End Select

Application.ScreenUpdating = False
Sheets("live_status").Copy

'convert to values
 
 Application.DisplayAlerts = False
    Range("A1:N64").Select
    Selection.Copy
    Range("A1:E1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 Application.DisplayAlerts = True

'delete charts

    ActiveSheet.ChartObjects("Chart 6").Activate
    ActiveChart.ChartArea.Select
    ActiveWindow.Visible = False
    Selection.Delete

    ActiveSheet.ChartObjects("Chart 7").Activate
    ActiveChart.ChartArea.Select
    ActiveWindow.Visible = False
    Selection.Delete

    ActiveSheet.ChartObjects("Chart 11").Activate
    ActiveChart.ChartArea.Select
    ActiveWindow.Visible = False
    Selection.Delete

'delete buttons

    ActiveSheet.Shapes("Button 8").Select
    Selection.Delete
    ActiveSheet.Shapes("Button 12").Select
    Selection.Delete
    ActiveSheet.Shapes("Button 13").Select
    Selection.Delete
    ActiveSheet.Shapes("Button 39").Select
    Selection.Delete

Application.ScreenUpdating = True

Call break_links

Range("A1").Select

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs ("Q:\live_updates\cs_email\UBER_Live_Report_" & Format(Date, "mm.dd.yy") & ".xls")
Application.DisplayAlerts = True
Application.Dialogs(xlDialogSendMail).Show arg1:="Test Dist List", arg2:="Evening Status Report"
ActiveWorkbook.Close

End Sub
 
tweek312,
not sure what you mean.
do you want to open outlook and give it focus or just check to see if it's there and use it, if not there then ...
regards,
longhair
 
I need it to be open when the user clicks send on the email. I do not want it to take focus, only create an istance of the program in the background. Additionally I would like it to be intelligent enough to know not to open a new instance of outlook if one is already open.

The reasoning is becuase if a session of outlook is not open when the user clicks send on the email it will not send the message until an instance of outlook is opened.

NOTE: I am using an Exchange server for mail.

Thanks,
tweek
 
tweek312,
simple:
Code:
If IsNull(Application.MailSession) Then
 Application.MailLogon "MS Exchange Settings", , False
End If
before you mail.
then if you want to close:
Code:
If Not IsNull(Application.MailSession) Then
 Application.MailLogoff
End If
hth
regards,
longhair
 
I found this code in a thread with a similar objective.

oOutlookApp = CreateObject("Outlook.Application")

I am pretty sure that this is the preferred method for invoking an outlook session; however I have no idea how to use it.

Any help that can be provided is great.

tw33k
 
Application.DisplayAlerts = True
On Error Resume Next
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then Set oOutlookApp = GetObject(, "Outlook.Application")
On Error GoTo 0
Application.Dialogs(xlDialogSendMail).Show arg1:="Test Dist List", arg2:="Evening Status Report"

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
The code is working without a hitch but still does not work as desired.

This is how I have the code:

Code:
Sub prep_everpt()

'makes sure user wants to prep report
Dim ReturnValue As Integer
   ReturnValue = MsgBox("Are you sure you want to compile the report?", vbQuestion + vbOKCancel, "Compile Report")
   Select Case ReturnValue
   Case vbOK
      
   Case vbCancel
      Exit Sub
   End Select

Application.ScreenUpdating = False

'convert to values
Sheets("live_status").Copy
 Application.DisplayAlerts = False
    Range("A1:N64").Select
    Selection.Copy
    Range("A1:E1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 Application.DisplayAlerts = True

'delete chart 6
ActiveSheet.ChartObjects("Chart 6").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete

'delete chart 7
ActiveSheet.ChartObjects("Chart 7").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete

'delete chart 11
ActiveSheet.ChartObjects("Chart 11").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete

'delete buttons
ActiveSheet.Shapes("Button 8").Select
Selection.Delete
ActiveSheet.Shapes("Button 12").Select
Selection.Delete
ActiveSheet.Shapes("Button 13").Select
Selection.Delete
ActiveSheet.Shapes("Button 39").Select
Selection.Delete

Application.ScreenUpdating = True

'breaks all links
Call break_links

'to clear the selection
Range("A1").Select

'saves file as name + date
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs ("Q:\live_updates\cs_email\UBER_Live_Report_" & Format(Date, "mm.dd.yy") & ".xls")
Application.DisplayAlerts = True

'starts email client
On Error Resume Next
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then Set oOutlookApp = GetObject(, "Outlook.Application")
On Error GoTo 0

'prepares send dialog
Application.Dialogs(xlDialogSendMail).Show arg1:="Test Dist List", arg2:="Process Support Evening Status Report"
ActiveWorkbook.Close


End Sub
 
Sorry for the typo:
If Err.Number <> 0 Then Set oOutlookApp = CreateObject("Outlook.Application")


Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
Still not operating as desired... What could the problem possibly be?

Code:
Sub prep_everpt()

'makes sure user wants to prep report
Dim ReturnValue As Integer
   ReturnValue = MsgBox("Are you sure you want to compile the report?", vbQuestion + vbOKCancel, "Compile Report")
   Select Case ReturnValue
   Case vbOK
      
   Case vbCancel
      Exit Sub
   End Select

Application.ScreenUpdating = False

'convert to values
Sheets("live_status").Copy
 Application.DisplayAlerts = False
    Range("A1:N64").Select
    Selection.Copy
    Range("A1:E1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 Application.DisplayAlerts = True

'delete chart 6
ActiveSheet.ChartObjects("Chart 6").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete

'delete chart 7
ActiveSheet.ChartObjects("Chart 7").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete

'delete chart 11
ActiveSheet.ChartObjects("Chart 11").Activate
ActiveChart.ChartArea.Select
ActiveWindow.Visible = False
Selection.Delete

'delete buttons
ActiveSheet.Shapes("Button 8").Select
Selection.Delete
ActiveSheet.Shapes("Button 12").Select
Selection.Delete
ActiveSheet.Shapes("Button 13").Select
Selection.Delete
ActiveSheet.Shapes("Button 39").Select
Selection.Delete

Application.ScreenUpdating = True

'breaks all links
Call break_links

'to clear the selection
Range("A1").Select

'saves file as name + date
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs ("Q:\live_updates\cs_email\UBER_Live_Report_" & Format(Date, "mm.dd.yy") & ".xls")
Application.DisplayAlerts = True

'starts email client
On Error Resume Next
Set oOutlookApp = GetObject("Outlook.Application")
If Err.Number <> 0 Then Set oOutlookApp = CreateObject("Outlook.Application")
On Error GoTo 0

'prepares send dialog
Application.Dialogs(xlDialogSendMail).Show arg1:="Test Dist List", arg2:="Process Support Evening Status Report"
ActiveWorkbook.Close


End Sub
 
Still not operating as desired...
Can you please be more specific ?

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
Well its not opening outlook and sending the email. Its just dropping it in the inbox until an actual session of outlook is open.

If an outlook session is already open then it sends immediately; but since this will be used by more than one person I cannot assume that they keep outlook open all the time.

I need outlook to open just before the system pops the mail dialog. Aftwords would not work because it would force the user (at least on our system) to manually send the mail from the outbox via Send/Receive button.

I hope this is clear enough. Please let me know what you think.

Thanks,
tw33k
 
tweek312,
did you try my suggestion?
i have no problem sending emails that way when outlook is closed.
regards,
longhair
 
Hi tweek,

This bit of code ..
Code:
'starts email client
On Error Resume Next
Set oOutlookApp = GetObject("Outlook.Application")
If Err.Number <> 0 Then Set oOutlookApp = CreateObject("Outlook.Application")
On Error GoTo 0

has a problem - it is missing a comma, but ..

Outlook is a single instance application - if you use CreateObject and Outlook is open you will just get a reference to the existing instance - which is the equivalent of GetObject, so you could just use ..
Code:
[blue]Set oOutlookApp = CreateObject("Outlook.Application")[/blue]
If, however, you want to close an Outlook session you have opened, which would be good manners, then try adding the comma in GetObject and remembering the result so you know what to do later ..
Code:
[blue]Set oOutlookApp = GetObject([highlight],[/highlight]"Outlook.Application")[/blue]

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at VBAExpress[
 
I use this in one of my apps, it trys to get an existing outlook object and if it does not find one attempts to open a new one. If it is unable to open a new one also then it gives an error resonse.

Set ol = GetObject("", "Outlook.application")
' If Outlook is NOT Open, then there will be an error.
' Attempt to open Outlook
If Err.Number > 0 Then
Err.clear
Set ol = CreateObject("Outlook.application")
If Err.Number > 0 Then
MsgBox "Could not create Outlook object", vbCritical
fSuccess = False
Exit Function
End If
End If

The variable fSuccess is used for other parts of the code.
I start by setting it to True and only alter it if an error occurs and then test that value to see if I should attempt opening the namespace and mailitem objects.


Paranoid? ME?? WHO WANTS TO KNOW????
 
I get no response from this code. It appears to do nothing. I was wondering if this is a Service Pack issue as I am currently using Office SP2 on XP SP2. Could this be somthing that changed in Office SP2? Im starting to wonder if my Office installation is corrupt.

Thanks For The Help Guys! =D

tW33k
 
tweek312, do you mean from the code I posted?
It was originally VBA code that I modified to use in a web application as VBScript. It is possible that I had tweaked the getObject or createObject lines to fit the VBScript syntax. I do not remember what was necessary to make it work in VBScript offhand but if you look up those commands you may find there is just a subtle difference between the VBA and VBScript implementations.

I can try looking around to see if I have the original code when I get in to work tomorrow.

Paranoid? ME?? WHO WANTS TO KNOW????
 
Well actually I mean all the code posted. None of it works in the least. I can bearly even get errors from the code. Its really weird.

I will look up the difference betweent the VB and VBA commands and let everyone know if i find anyting but... This doesnt look good at all..

=Dthx=D

tW33k
 
Well guys... I found another way... Seems a bit wanky but it will work for what I need it to do.

VBA.Shell ("C:\Program Files\Microsoft Office\OFFICE11\OUTLOOK.EXE")

VBA.Kill ("C:\Program Files\Microsoft Office\OFFICE11\OUTLOOK.EXE")

Might have a probelem with other versions of outlook though.

I would like to have it work the way that you guys had showed me but I cannot find much on how to use the "CreateObject" thingy.

Thanks for your continued help... Please let me know if you find somthing that will work...

=D
tW33k
 
VBA.Kill ("C:\Program Files\Microsoft Office\OFFICE11\OUTLOOK.EXE")
You really want to delete this file ????

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

Thats funny! Good thing windows wont let me do that... =D

This is proof that I am a VBA gooftard...

Thanks!
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top