简体   繁体   中英

Open and Activate Outlook via VBScript

I'm using VBS to control a process wherein I need to open Outlook and activate/set focus on the window. I'm running into issues with setting the focus on the window - when it runs, the window focus remains on the Explorer window I had open to double-click and run on the VBS file.

From what I've read, opening a new Outlook instance should take the focus, and if I run the script without having focus on the Explorer window (such as using Sendkeys) it works perfectly fine, but it does not work if the Explorer window has focus. This is important as it will be set through Task Scheduler to run, and so it needs to work no matter where the current focus is when the task runs.

Here's the existing VBS:

Option Explicit

OpenOutlook

Sub OpenOutlook()

  Dim oApp
  Dim oName
  Dim oFolder
  Dim WShell

  Set WShell = WScript.CreateObject("Wscript.Shell")
  Set oApp = CreateObject("Outlook.Application") 
  Set oName = oApp.GetNamespace("MAPI")
  OName.Logon "Default Outlook Profile",, False, True
  Set oFolder = oName.GetDefaultFolder(6)
  oFolder.Display
  OApp.ActiveExplorer.Activate
  WShell.AppActivate "Inbox - myemail@mydomain.com - Microsoft Outlook"

End Sub

So, experimentation found a work-around - move the WShell commands out of this VBS macro and into a seperate VBS macro, then call the two back to back from a third macro. Here's the finalized layout:

Shell VBS:

Option Explicit

SendTLShell

Sub SendTLShell()

  Dim filepath
  Dim oShell
  Set oShell = CreateObject("Wscript.Shell")

  filepath = Chr(34) & "\\myfilepath\OutlookControl.vbs" & Chr(34)
  oShell.Run "wscript " & filepath, , True

  filepath = Chr(34) & "\\myfilepath\SendReports.vbs" & Chr(34)
  oShell.Run "wscript " & filepath, , True

  Set oShell = Nothing

 End Sub

Outlook control VBS:

Option Explicit

OpenOutlook

Sub OpenOutlook()

  Dim oApp
  Dim oName
  Dim oFolder

  Set oApp = CreateObject("Outlook.Application") 
  Set oName = oApp.GetNamespace("MAPI")
  OName.Logon "Default Outlook Profile",, False, True
  Set oFolder = oName.GetDefaultFolder(6)
  oFolder.Display
  OApp.ActiveExplorer.Activate

  Set oApp = Nothing
  Set oName = Nothing
  Set oFolder = Nothing

End Sub

SendReports ("Activation") VBS, also does some Excel things:

Option Explicit

RunFilePullMacro

Sub RunFilePullMacro() 

  Dim xlApp 
  Dim xlBook 
  Dim oShell
  Dim wShell

  Set wShell = WScript.CreateObject("Wscript.Shell")
  Set oShell = CreateObject("Shell.Application")
  oShell.MinimizeAll

  wShell.AppActivate "Inbox - myusername@mydomain.com - Microsoft Outlook"
  Set xlApp = CreateObject("Excel.Application")
  xlApp.Application.Visible = True
  xlApp.DisplayAlerts = False 
  Set xlBook = xlApp.Workbooks.Open("\\myfilepath\myexcelfile.xlsm", 0, True) 
  xlApp.Run "FeedbackCheck"
  xlApp.ActiveWorkbook.Close
  xlApp.DisplayAlerts = True
  xlApp.Quit 

  Set xlBook = Nothing 
  Set xlApp = Nothing 
  Set oShell = Nothing
  Set wShell = Nothing

End Sub 

I would be curious still if anyone knows of a better solution or why this may be required.

This probably isn't an ideal solution, but I decided to go this route:

Make an excel book with the following macro in it:

Sub Open_Outlook()

Shell ("OUTLOOK")

End Sub

Then, you can make a VBS script that opens that excel workbook & runs the macro that opens outlook.

Not elegant, but functional :)


Dim objExcel
Set objExcel = CreateObject("Excel.Application")

'the line below opens an excel book

objExcel.Workbooks.Open("C:\Users\bal01483\Desktop\AUTOMATION\EMAIL\OutlookBook.xlsm") 

objExcel.Visible = True

'the line below runs a macro inside the excel book which will open outlook

objExcel.Run "ThisWorkbook.Open_Outlook"  'this macro opens opens outlook

objExcel.Quit

'''''''''''''''''''''''''''''''
''BEGIN OUTLOOK EMAIL SEGMENT''
'''''''''''''''''''''''''''''''

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM