Sleeper: 'New Outlook' Broken my VBA

[MBACON]

Good Morning All.

Hopefully this will be a quick one.

Op: Office365 (enterprise)
Outlook: version 2303 (16227.20280)

The Problem.

Having developed and running the workbook withou issue for about 12months it has now started erroring.

At the startup of the workbook the users email address is got (to both log and send messages in the background redaing selections they make).
To stop it falling over, i added a line to check if outlook is running, and if not tell them it needs to be and then closes the book.
(Code below).

Now with the recent release of 'New Outlook' (toggle)
http://www.vbaexpress.com/forum/image/png;base64,iVBORw0KGgoAAAANSUhEUgAAANsAAAB5CAYAAACwV1SlAAAAAXNSR0IArs4c6QAA AARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAAoXSURBVHhe7d1faBTbHQfwX7Q pGNHEGvxTkjRW1Bv/ax8kakHEqoh6EYpGELHah168VxQE40Pvw 2DCoJ/WrEPNRWRmkpB7lVEbVAflCD0 v9PjfVPjdyrEjUqUWk0qd z56zHubszk83ucWb9fmDYnZmzk8ns c45c2Y3KZDay51CRDnXQz8SUY4xbESOMGxEjjBsRI4wbESOMGxEjjBsRI4wbESOMGxEjjBsRI4w bESO5MVnI7/61QCpGVssw0p/rOZvtPxP6i8 lS// VDNE0VB7Fu2xs9 Lr/5RYkKV8H6K2rCcyzDOqKoiHXY0KKVFf9Ipv759nutGJ5jGdahDFEUxDps6Dr 9dtW W9ru17yDpZhHcpQ7ny9tEI6N4x6b2r7qkoaflspPysp1KWip7l2uCzyqRtYhzLZFOtrNryx6Db6 CVOGsgshq19cLm3tHTLjL3f00mhBmHZ8OlhWfv29/P3tZYfNb113cDSSMpKqRTPT9vmDpWZfs1RX9NKlowchQpgQKruFy1XQgGGjjMyv6iOVm5qSg1Jm wjKsQze qDDa1csbuFwGDRi2D6Tl95 kbBXsCWWiLN21cpzYgctl0IBh 0BK//DvH7QK3gllKH8wbPRRs7uOdpcyF2Ibtl9WFsmL9g49lx7KRHkIOp99c 25fhZN3ms07zVctsUybKsm95e/1ZRJw3/a9JL0UObU74bk7Gz1MUt1ErOXfbrnrn4WPd6gGbkMXCzvs2Hw4E Nj WLb77XS/z9cf5g bz6J o6iLIDQ/8YdUwFLVqUgwa4Yb328IO0gyEI2uY5A6V8Y5Ne0n2xDVsmGDb6kPLmLyLjI0LL//Gdel73659K7y vqedEUZE3o5F1/2pVIVPT2 dEUZM3LRtR1PE G5EjDBuRIwwbkSMMG5EjDBuRIwwbkSMMG5EjDBuRIwwbkSMMG5EjDBuRIwwbkSMMG5EjDBuRIww bkSMF9 7d4/fZiHKoQE9s2Yic6GTYiFxh2Igc4TUbRd7t27flxo0bcvPmTXn /Lmacq1Pnz5qGjp0qAwbNkyGDBmi13Rd4pqtk2Gj6Gpra5OGhgZpbm6WSZMmyZgxY6R///5SXFwsBQWowrnR2dkpz549k5aWFrl06ZKcOXNGysrKZObMmVJUVKRLhcewUaSdO3dOjh07JpMnT 5ZFixblNFxBEL79 /fLqVOnZNasWTJhwgS9JhyGjSLr/Pnz0tjYKEuXLpXhw4dLR0eHHDp0SO7cuaMmqKysVNPcuXOlRw83Qw9NTU2yZ88eqa6ulvHjx ulwRg2iqQnT57Ijh07ZM2aNSpoFy5ckH379snDhw91ifcNGDBAFi9eLOPGjdNLcguB27Jli6xcu VL69eunl/ozYeNopDZt2rTkWfNjls3jkMm2Dh8 LHPmzEkGbdu2bWmDBliHMijrAvYL 4f97JqC6Idt9erV6k3zTjU1NbpEZrCNfAmX99h05feK0nG4di3x/xnmzZunuo5o0cJCWbzGBewfriGvXr2ql4QT bBt3bpVTp48qSbYvXu3el5fX6/mP2YICcKydu3a5DHatGmTLFu2TI2gxc3169eTgw 4RvNr0bxQFq/xc/DgQVm fHly2r59u16TgHksx3VZqnnbxIkT1e2Iroh1NxIVDZUKj2jp0AraBxzrvC2gqaCASonXGJcvX1b rMNXV1emlCXYL61eRsR77YMp6K0Cq7Xj3216HR3sfbTgRYRABgwQGhsgRPrtVwPbs1gvzGFnDI3 iPg23jxo2qHKZUvYmg9YYp59eKYoh/1KjEvwPLpLX1ew2CduDAAfW mqm1tfW9wGFgZv369eqYppq3VVVVyd27XfsfdLG/ZsPFqmnpZsyYoe7LGCdOnJAlS5bouQSMYNmtJCqsgdea1sE m6GiDBo0SK3Da/Az/ZjtoNJv3rxZL02/Hew3gg4IF8pcuZL4X3J4HDt2rHruhcowffp0PfcOwod1fpUP943SHQcD 3v//n1VDhNG4OxQBq03ULFNORz/dJ4 fZocdMh22FAXVqxYoecSMLCC44QWCi0YbNiwQU6fPv2DeS/sJ/a3K2IfNoxaGaaSGXg evRoPRfMVBS0DmDevCNHjiTP2qgsCIPfG2u2Y1qcoO1gH81 I1w4QVy8eFHN49Gc7W1mm36Vt7uwv6iQBvbdPr5B6wEnEfwOqcKcSi6G8REmtGJTpkzRSxLwyZC SkhLVBTU9GbRkKOedz4bYh23gwIH6WcLs2bNV62BaiO5WRlOp0dUy3SVUqAcPHqjlYfltx wjyqBiIqRoCQCPJvw2 zXpZCOI9vFN9TOD1qNlDxs0fDLk8ePH6nkm 56N3zcs3KLA/oaXh0P/aCXQZUALge5Zd5k30AzMmClVAPwEbQddMNOVBMzjOs7v5inWHT9 XM 9E/S6rkh1UrErddB6dMlxYgmjoqIi2X3OJDjpXoMWDLzdwXQtXhgYiSwvL9dz4eRd2ExXEh/1Md24dMK2Tqi42Rj99NsOThK41jPXZ2berxuMLhyuLe3BFbToaE3s7h1aeBNK0z2ypTsO6CXYAy 24RsMyI2g9oOULGziE4uzZs o53jvcsA4LZf3eb/z8Xbt26bmEnTt3ZnxSwsfJRowYoefCybuwAQ5g0EFEpVi3bl3aUTgbukEIsOn hXlNKn7bMddt5vrMzPuFDa0iWkqEy2wTvxOW2S0vrmsRSqz38jsOtbW16tFsG11aswyC1hvYF4z ooYx3dNY2cuRI9YiRQ1y72SeMICjrd72Hn79gwQI18GEm1JFVq1bpEuFh/wAjkl2Rlx/XwhkWlTSoZaPoyeePa Vd2HBxjrMrb3rHF1p0dIcxKhu1DyLv3btXtdRd6X7mZdjQomE4GtcIdjeK4gfXREePHpWpU6fKw oULI/EVGwyw4Dtt/IoN5Z0XL16oga63dVSdPPHl0dLSUunbt2/OvzyKG9aPHj1KfnkUI48Y3e7du7cuFR7DRrHBP4tARKGYsOXl0D9R9MTg 2xE YJhI3KC3UgiZwpu3brFARKiEMztBtxExxT29kNyNLITNxWIKJQ3b95Ie3u7ug/36tUr6dmzZ2DoGDaibnr58qW68Y0I X1kjGEjygJ8bhN/iwQtXLrAmbBxgISoGxAwfGfv9evXqoXzw7ARdVOvXr3UFPR3Kxk2oizAHw7C4Ilf68awEWVBYWG hatkYNqIcw7UbWjY/DBtRFuBem lGpmvdGDaiLPELGjBsRFniFzRg2IgcYdiIsoQtG1FEMGxEjjBsRI4wbESOMGxEjjBsRI4wbESOM GxEjjBsRI4wbESOMGxEjjBsRI4wbESOMGxEjjBsRI4wbESOMGxEjjBsRI4wbESOMGxEjjBsRI4w bESOMGxEjjBsRI4wbESOMGxEjjBsRI4wbESOMGxEjjBsRI4wbESOMGxEjjBsRI4wbEROiPwfFdF YGTaB3BoAAAAASUVORK5CYII=
If I have this version of outlook running instead, [which I quite like], then the code line does not see outlook as running?!? (and therefore doenot pick up the users email either)

Any suggestions why this might be would be great, would like to get something inplace before work pushes the release out formally.

cheers.
M.

TLDR: If current Outlook is open oOutlook NOT Nothing; if New Outlook is open, oOutlook IS Nothing; if Outlook is closed, oOutlook IS Nothing.

The Code:




Public Sub email_hunter()


Dim oOutlook As Object 'Checks Outlook is open.




On Error Resume Next

Set oOutlook = GetObject(, "Outlook.Application")

On Error GoTo 0



If oOutlook Is Nothing Then

MsgBox "Outlook is not open, open Outlook and try again. " & vbNewLine & vbNewLine & _

"'New Outlook' does not work either(PreRelease)" & vbNewLine & vbNewLine & _

"Please open Outloook email and try again."

ActiveWorkbook.Close SaveChanges:=False

Else



Call mod_MISC.currentUserEmailAddress

USER_email = currentUserEmailAddress



End If


end sub

[arnelgp]

You can try this code:


' https://social.msdn.microsoft.com/Forums/en-US/93674f48-299e-4880-b77f-5f7bc66b2e75/names-of-currently-running-applications?forum=isvvba
Public Function IsProgramOpen(ByVal program_name As String) As Boolean
' Arnelgp
'
' Example:
'
' test if Outlook is already running
'
' ? IsProgramOpen("OUTLOOK.EXE")
'
' some common program names:
'
' "OUTLOOK.EXE" to test for Outlook is already running
' "MSACCESS.EXE" to test if MS Access is already running
' "EXCEL.EXE" to test for Excel
' "WINWORD.EXE" to test for Word application
' "POWERPNT.EXE" to test for Powerpoint
'
' etc.
'
Const THIS_PC As String = "."
Dim objWMIService, colItems, objItem
Dim sName As String


Set objWMIService = GetObject("winmgmts:\\" & THIS_PC & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process", , 48)


program_name = UCase(program_name)

For Each objItem In colItems
sName = UCase(Trim$(objItem.Name))
If sName = program_name Then
IsProgramOpen = True
Exit For
End If
Next
End Function

on immediate window (VBA) you test:

?IsProgramOpen("OUTLOOK.EXE")

[Paul_Hossler]

This is a snippet I use to send Outlook emails

Uses Outlook if open, opens Outlook if not




'open Outlook or create if not open
On Error GoTo OutlookError
Set oOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0

.......


Exit Function


OutlookError:
If Err.Number = 429 Then
Set oOutlook = CreateObject("Outlook.Application")
Resume Next
Else
SendWithOutlook = False


End If

[MBACON]

Thanks for the replies.

Interestingly and looking into TM a bit more, the 'New Outlook' runs as olk.exe

still trying to work out what the > Set oOutlook = GetObject(, "Outlook.Application")
command is for this alternative.

but for now I am using your [Arnalgp] function checking for true in either OLK.EXE or OUTLOOK.EXE

[Aflatoon]

As far as I can see, the new outlook seems to be more of an app with no VBA support. (if memory serves, wasn't olk.exe the old outlook express executable? If so, hardly "new outlook" ;))

[MBACON]

Just a quick update. - I'll leave it as open for now without solution, although it looks like it may not be possible.:crying:

I implemented program check function suggested with an or statement picking up either version.
However, although it accepts the OLK as true, i does'nt pull the needed info (Users email address and line manager), nor does it send any messages, just loads them as draft emails then sends when outlook(.exe) opens.

Back to the drawing board, may for now just have to force users to open the original outlook rather than the new fangled preview - see what happens when it comes out into formal release and hope a proper hand off is established.:doh:

[Hilltroop]

Nice update. Let me see your results.

[Hilltroop]

Announce me when you have the results.

[Aussiebear]

@ Hilltroop, Try being polite about your requests.

[bonjovi]

One potential solution is to use the CreateObject function instead of GetObject.wordle (https://wordlewebsite.com)

[kalyl]

Try checking for both versions of Outlook to cover all scenarios.


On Error Resume Next
Set oOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0
If oOutlook Is Nothing Then
' Try to get the new Outlook
On Error Resume Next
Set oOutlook = GetObject(, "Outlook.Application.23")
On Error GoTo 0
End If