Accessing the ‘Body’ of an Outlook email from Excel VBA - excel

The following Excel VBA code stopped working after upgrading from Office 2010 on Windows 7 to Office 365 on Windows 10.
Sub readbodytest()
    Dim OL As Outlook.Application
    Dim DIB As Outlook.Folder
    Dim i As Object 'Outlook.ReportItem
    Dim Filter As String
    Set OL = CreateObject("Outlook.Application")
    Set DIB = OL.Session.GetDefaultFolder(olFolderInbox)
    Const PR_SENT_REPRESENTING_EMAIL_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x0065001E"
    Filter = "#SQL=" & _
        """" & PR_SENT_REPRESENTING_EMAIL_ADDRESS & """ ci_phrasematch 'mailer-daemon' OR " & _
        """" & PR_SENT_REPRESENTING_EMAIL_ADDRESS & """ ci_phrasematch 'postmaster' OR " & _
        "urn:schemas:httpmail:subject ci_phrasematch 'undeliverable' OR " & _
        "urn:schemas:httpmail:subject ci_phrasematch 'returned'"
    For Each i In DIB.Items.Restrict(Filter)
        Debug.Print i.Body '<< Code fails here
    Next
    Set i = Nothing
    Set DIB = Nothing
    Set OL = Nothing
End Sub
In Excel, it returns
runtime error -2147467259 “Method 'Body' of object '_MailItem' failed”
The code will work when run directly in Outlook VBA, but not when run externally.
The purpose of the code is to do a bulk review of returned mail items, match information in the body of the email to a record on a database, and update the database to record the failure.
Looking to see if anyone has any suggestions before I re-write the code to run in reverse (from Outlook VBA to Excel; instead of Excel trying to retrieve from Outlook).

It makes sense to use the Logon method of the Application class which logs the user on to MAPI, obtaining a MAPI session. Here is what MSDN says:
Use the Logon method only to log on to a specific profile when Outlook is not already running. This is because only one Outlook process can run at a time, and that Outlook process uses only one profile and supports only one MAPI session. When users start Outlook a second time, that instance of Outlook runs within the same Outlook process, does not create a new process, and uses the same profile.
If Outlook is not running and you only want to start Outlook with the default profile, do not use the Logon method. A better alternative is shown in the following code example, InitializeMAPI: first, instantiate the Outlook Application object, then reference a default folder such as the Inbox. This has the side effect of initializing MAPI to use the default profile and to make the object model fully functional.
Second, I'd suggest checking the item type before accessing any properties. Not all items may contain such properties.
Another possible pitfall and most probably that is a security issue when dealing with the Outlook object model. When you try to access any sensitive property Outlook may trigger a security issue (it may be an error in the code or UI guard/prompt). "Security" in this context refers to the so-called "object model guard" that triggers security prompts and blocks access to certain features in an effort to prevent malicious programs from harvesting email addresses from Outlook data and using Outlook to propagate viruses and spam. You can use the following ways to bridge the gap:
The Security Manager for Outlook component allows to turn prompts off/on at runtime.
Use the low-level code which doesn't generate security prompts. Or any other third-party wrappers around that API (for example, Redemption).
Deploy a group policy to avoid security prompts.
Running an up-to-date antivirus software.

Related

Unable to add records to Sharepoint List from Excel VBA using shared link

I'm trying to create an Excel user form that will add newrecords to a Sharepoint List. The problem is that this form needs to be available to all users in my organization, without their being specifically permissioned to the List.
The basic URL for the Sharepoint List looks something like this:
https://myorg.sharepoint.com/personal/myname/;LIST=SubmissionsTest;
However, this link only works for me. If I try to Share the List with people in my company, Sharepoint provides me with a link that looks like this:
https://myorg.sharepoint.com/:l:/g/personal/myname/arandom50charactertextstring
Test users have confirmed they can access the List via the second link, but not the first.
To push records into the List from Excel, I've created the following VBA code:
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim mySQL As String
Set cnt = New ADODB.Connection
Set rst = New ADODB.Recordset
mySQL = "SELECT * FROM SubmissionsTest;"
With cnt
.ConnectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;WSS;IMEX=0;RetrieveIds=Yes;" _
& "DATABASE=https://myorg.sharepoint.com/personal/myname/;LIST=SubmissionsTest;"
.Open
End With
rst.Open mySQL, cnt, adOpenDynamic, adLockOptimistic
rst.AddNew
rst.Fields("Title") = Int(Now() * 100000)
rst.Fields("testEntry") = "This is a test submission"
rst.Fields("testSubmitter") = Environ("UserName")
rst.Update
If CBool(rst.State And adStateOpen) = True Then rst.Close
If CBool(cnt.State And adStateOpen) = True Then cnt.Close
MsgBox "Your submission has been received."
This code works fine when I run it. As expected, it does not run for my test users. However, when I try substituting that second, Sharepoint-provided link into the Connection String, the code no longer works either for me or my test users. Instead, we receive errors telling us the SubmissionsTest object cannot be found.
I have yet to be able to figure out how I can tweak this code so that the Shareable link is recognized. Does anyone have any ideas on how this can be accomplished?
Thanks in advance for any suggestions.
OK, I found the solution after studying this posting on the Microsoft forums: https://social.technet.microsoft.com/Forums/en-US/2a1b718a-e9a5-4a1d-96a9-97804ebef769/vba-to-insert-record-to-an-existing-sharepoint-online-list?forum=sharepointgeneral
As indicated in the code above, the Connection String I was trying to use was:
DATABASE=https://myorg.sharepoint.com/personal/myname/;LIST=SubmissionsTest;
Even after permissioning the Sharepoint List for anyone in the firm, Excel reported that it was unable to find the table "SubmissionsTest". On the recommendation of the post above, I looked up the GUID values for the List. That returned a string that looked something like this:
<LIST><VIEWGUID>alongstringofalphanumericcharacters</VIEWGUID>
<LISTNAME>anotherstringofcharacters</LISTNAME>
<LISTWEB>https://myorg.sharepoint.com/personal/myname/</LISTWEB>
<LISTSUBWEB></LISTSUBWEB><ROOTFOLDER></ROOTFOLDER></LIST>
Once I changed the Connection String to this:
DATABASE=https://myorg.sharepoint.com/personal/myname/;LIST={anotherstringofcharacters};
the code now works for everyone. My conclusion is that, on SharePoint O365, table names cannot necessarily be trusted. Sometimes, the GUID values will need to be referenced directly.

Sending Massive emails on excel vba, OLE issue

I hope you're doing great.
I'm using this code to send emails in VBA Excel, but it only works one time, then I have to close Outlook on Task manager. If I don't do this, I get a message that says "Microsoft Excel is waiting for another application to complete an OLE action". The only thing I have to do is close the outlook app on the task manager, and then it works perfectly fine.
Could you please help me fix this issue please? Below I'll post my code
Dim email As Outlook.MailItem
Dim direc As String
Dim body As String
Set A = New Outlook.Application
For i = 2 To ActiveSheet.Cells(Rows.Count, 16).End(xlUp).Row
direc = Worksheets("NewSheet").Cells(i, 16).Value
Set email = A.CreateItem(emailItem)
With email
direc = Worksheets("NewSheet").Cells(i, 16).Value
If (direc <> "0") Then
.To = direc
.Subject = "Notification Test"
body = Worksheets("NewSheet").Cells(i, 14)
.HTMLBody = "<HTML><BODY style=font-size:11pt;font-family:Calibri>This is a notification reminder to let you know that you have <b>" & body & "</b> open contact(s) that you must Update</BODY><br><br>Best Regards, </br></br><br> Anonymous </br></HTML>"
.Display
.Send
End If
End With
Next i
Thank you so much for your time and help.
Do not call both Display and Send. Get rid of the Display line.
I'd suggest trying to run the code in Outlook VBA environment to make sure the issue is not related to security issues when sending emails. The fact is that the Outlook object model generates security issues or give security prompts to users when protected properties or methods are called using automation. Or just may try to call Save instead of Send in the following way:
Set email = A.CreateItem(emailItem)
With email
direc = Worksheets("NewSheet").Cells(i, 16).Value
If (direc <> "0") Then
.To = direc
.Subject = "Notification Test"
body = Worksheets("NewSheet").Cells(i, 14)
.HTMLBody = "<HTML><BODY style=font-size:11pt;font-family:Calibri>This is a notification reminder to let you know that you have <b>" & body & "</b> open contact(s) that you must Update</BODY><br><br>Best Regards, </br></br><br> Anonymous </br></HTML>"
.Save
End If
End With
Next i
If this code works correctly than a security issue is the case.
The Send method may fire an exception when you try to automate Outlook. In this case most probably you are faced with an Outlook security issue. It can also be a prompt issued by Outlook if you try to access any protected property or method. But in your case that can be an exception or error. You get the security prompts/exceptions because Outlook is configured on the client computer in one of the following ways:
Uses the default Outlook security settings (that is, no Group Policy set up)
Uses security settings defined by Group Policy but does not have programmatic access policy applied
Uses security settings defined by Group Policy which is set to warn when the antivirus software is inactive or out of date
You can create a group policy to prevent security prompts from displaying if any up-to-date antivirus software is installed on the system or just turn these warning off (which is not really recommended).
Read more about that in the Security Behavior of the Outlook Object Model article.
Also you may consider using a low-level code on which Outlook is built and which doesn't give security issues - Extended MAPI. Consider using any third-party wrappers around that API such as Redemption.
Another option would be the Outlook Security Manager which allows suppressing Outlook security issues at runtime on the fly.

User Defined Functions (UDF) from Access Query to Excel using VBA OpenRecordset failed - Undefined Function

How do I get the results of a query from Access into Excel if it has a UDF?
I receive the following error: "Run-time error '3085': Undefined function 'XXXX' in expression". The error occurs when opening an (access query) recordset from Excel VBA. The query being opened has a user defined function (UDF) which is triggering the error.
The code is in Excel Office 365. The query is in Access Office 365.
I have successfully utilized the query being called (and others with the UDFs) for about twelve months, and "suddenly" it is not working any more. I have googled and tested many options with no success.
Most threads say it can't be done, or to not use a udf but try a built-in that works. I am challenging those responses because it has worked previously. The main udf I am using is one called "iMax" which is written about in other posts. It functions like max() in Excel. (No max(x,y) function in Access)
I have also seen threads that suggest executing this in two steps: 1 - change the query to a make table query. 2 - pull the table results into Excel. While I could maybe get away with this (after much rework), it would result in me making many temporary tables with thousands and thousands of rows and doesn't seem very slick.
I have compiled vba and compacted the db with no impact to my problem.
As a long shot I created a dummy database with a simple udf public function that returned the number 1, a simple query that returns three records and a field for the function results. This gets the same error when pulling into Excel.
Sub RunQuery()
Dim MyDatabase As dao.Database
Dim qdf As dao.QueryDef
Dim rs As dao.Recordset
Dim qryname As object
Dim SheetName As String
Set MyDatabase = DBEngine.OpenDatabase _
("SomePath\SomeFilename.accdb")
For Each qryname In Range("SomeRange")
Set rs = MyDatabase.OpenRecordset(qryname) '<<<ERROR IS HERE
SheetName = "SomeSheetName"
With Sheets(SheetName)
.ListObjects(SomeTableName).DataBodyRange.Rows.ClearContents
.Range("A2").CopyFromRecordset rs
End With
Set rs = Nothing
Set qdf = Nothing
Next qryname
End Sub
For all queries in the For loop that do not have a udf, the results are pulled and dumped into a series of tables in Excel. Any query with a udf errors at the "Set rs = Mydatabase.OpenRecordset(qryname)
If you run the query within an Access application session, as Gustav suggested, the expression service can handle the UDF in your query.
Here is a quick tested Excel VBA snippet which pulls data from a query which includes a UDF:
Const cstrDbFile As String = "C:\share\Access\Database2.accdb"
Dim objAccess As Object
Dim rs As Object
Dim ws As Worksheet
Dim strSelect As String
Set objAccess = CreateObject("Access.Application")
objAccess.Visible = True ' useful during testing '
objAccess.OpenCurrentDatabase "C:\share\Access\Database2.accdb"
strSelect = "SELECT ID, DummyFunction('a', '', 'c') FROM Dual;"
Set rs = objAccess.CurrentDb.OpenRecordset(strSelect)
If Not rs.EOF Then
Set ws = ThisWorkbook.Sheets("Sheet1")
ws.Range("A1").CopyFromRecordset rs
End If
rs.Close
objAccess.Quit
Most threads say it can't be done,
and they are right.
Your only option is to use automation to open an instance of Access and, within this, run the query.
Well, as noted, most are saying this should not work.
However, if you are 100% sure it was and did work at one time?
You need to set the "sandbox" mode of the JET (now ACE) database engine.
The expression service normally does not allow evaluation of VBA functions as a security setting to prevent SQL injection, or code running outside of Access to allow SQL to run + call VBA functions. At one time, this feature did default to "on", but now the default is set to access only.
You have to set the folder where Access application as trusted. This should allow the VBA functions to now work. so, make sure you set the folder as trusted.
If the location (folder) where your access application is NOT trusted, then Access will use sandbox mode, and VBA in the SQL will not run.
If the location is trusted, THEN access uses the registry setting on your computer.
My bets are that the location is not trusted - so you always get sandbox mode for SQL in Access.
If you are 100% sure that the folder location is set as trusted in Access, and you still receive the errors, then you have to change the registry setting for Access "sandbox" mode.
The setting in the registry is outlined here:
https://support.office.com/en-us/article/Turn-sandbox-mode-on-or-off-to-disable-macros-8CC7BAD8-38C2-4A7A-A604-43E9A7BBC4FB
The registry settings are:
for x32 bit access:
Software\Microsoft\Office\ClickToRun\Registry\Machine\Software\
Wow6432Node\Microsoft\Office\16.0\Access Connectivity Engine\Engines
The above is for Office 2016
14 = 2010
15 = 2013
16 = 2016
The key value for sandbox mode is:
0 to 3
0 Sandbox mode is disabled at all times.
1 Sandbox mode is used for Access, but not for non-Access programs.
2 Sandbox mode is used for non-Access programs, but not for Access.
3 Sandbox mode is used at all times. This is the default value, set when you install Access
So, from above, you want a setting of 0.

How to stop OutLook Security Message programatically : A program is trying to access e-mail addresses, Allow access for 1 Minutes [duplicate]

This question already has answers here:
Suppress dialog warning that a program is trying to access my mails
(3 answers)
Closed 4 years ago.
How to stop OutLook Security Message :
A program is trying to access e-mail addresses, Allow access for 1 Minutes
I want to stop this alert programatically and want to allow vba to access inbox of outlook,, since I dont have admin access for the outlook, I cant solve this manually going to trust center settings in outlook
My code works perfectly fine but op up security msgs need to check access for 10min again and again
Using excel vba I'm accessing outlook mails and downloading attachments from mail
Dim sa, ba As Date
Dim spa As Date
Set ObjO = CreateObject("Outlook.Application")
Set olNs = ObjO.GetNamespace("MAPI")
Set objFolder = olNs.GetDefaultFolder(6)
Debug.Print objFolder
spa = Date
Dim j
j = 0
For Each item1 In objFolder.Items
sa = Format(item1.ReceivedTime, "dd-MM-yyyy")
If sa <= spa Then
If sa > spa - 30 And item1.SenderName = "PUJARY, SHRIKANTH" Then
At execution of item1.senderName line that security alert is popping up
Ran into the same thing, there is no simple solution. In essence, the popup is there to prevent the exact thing you are trying to do: Controlling Outlook remotely. It was build as a defence against VBA/Macro viruses. So no, you cannot prevent this.
Solutions are to use the Extended Messaging API (MAPI) instead, but thats no easy task. Helper libraries can be bought, for example vbMAPI or Outlook Redemption
What's the difference? While the VBA method allows you to grab into a running instance of Outlook, MAPI requires you to log into the MAPI profile using username/password. This hasn't the security problems that tapping into Outlook has and is thus safe.
If using Redemption (I am its author) is an option, modifying your script in a couple places would make it run without security prompts:
dim sItem
set sItem = CreateObject("Redemption.SafeMailItem")
For Each item1 In objFolder.Items
sItem.Item = item1
sa = Format(item1.ReceivedTime, "dd-MM-yyyy")
If sa <= spa Then
If sa > spa - 30 And sItem.SenderName = "PUJARY, SHRIKANTH" Then

Accessing outlook message body with excel vba: error 287

We have a lot of emails saved to a folder on the file system to be processed by extracting text from the message bodies. Office 2010.
Dim app As Object
Dim msg As Object
dim msg_body as string
Set app = New Outlook.Application
Set msg = app.CreateItemFromTemplate("c:\path\to\message.msg")
msg_body = msg.body
This code works fine on my laptop however when I use it on the work network it gives error '287'.
While debugging I noticed that I can view msg msg.display and even change the body with msg.body = "some text". However I cannot read the message body. Also tried msg.HTMLbody which could not be read.
The most probable cause is your company's policies.
Check this registry key to solve the SaveAs (change the 16 to your office version).
hkcu\software\policies\microsoft\office\16.0\outlook\security\promptoomsaveas
You can change the value to 2, or ask your system administrator to create a new GPO.
More information on this and other security configurations in:
https://support.microsoft.com/en-za/help/926512/information-for-administrators-about-e-mail-security-settings-in-outlo

Resources