Error code 80040217 when using Outlook 365 with CDO - vba

I have been using CDO from my access application successfully for some time. We are now moving to Office (and Outlook) 365. My CDO code now doesn't work and gives a transport error 80040217. I have read that this error has to do with username and password authentication. According to our server admin I have the right information.
I have seen conflicting articles as to whether or not CDO can be used with 365. I have also tried the different port numbers (25 seems to be the right one). I also have seen older articles saying the server should be a pod id like podxxxxx.outlook.com, but then other articles say that is old and to just use smtp.office365.com.
I have no idea how to get the pod information if that is what I need.
I have attached the code I am using, but I was wondering if anyone knows whether CDO really does or does not work with 365. If it does, is there some setting we may be missing on our server? Our admin has sent an email with this address through the command line, so it appears the userid is good, but he used Base 64 encoding for the username and password. I tried that but it didn't work either.
I have also tried using the MX endpoint for the smtpserver value like myaddress-com.mail.protection.outlook.com and I still get the error.
Any suggestions?
Dim cdoConfig As Object, objMessage As Object
Set cdoConfig = CreateObject("CDO.Configuration")
With cdoConfig.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")="smtp.office365.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=25
.Item("http://schemas.microsoft.com/cdo/configuration/username")="donotreply#myaddress.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword")="passwordhere"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")= 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl")=True
.Update
End With
Set objMessage = CreateObject("CDO.Message")
Set objMessage.configuration = cdoConfig
objMessage.To = "someone#myaddress.com"
objMessage.FROM = "donotreply#myaddress.com"
objMessage.Subject = "test"
objMessage.textBody = "put the body here"
objMessage.Send

Related

No longer able to send e-mails with VBA and google smtp - Additional Info

Similar problem to "Resca's" Utility to send email to Gmail stopped working after google implemented OAuth. I have an excel workbook using VBA to ONLY SEND individual gmails to multiple “google group” members. It had been working for 4 years until Gmail added Oauth.
I have done tests with OAuth code from "Email Architect". I can test the app in test mode and it will send the email if I click passed the alarms and add include read. Compose, send and delete permissions. When I configure it as production I get not verified message and go through a similar routine that "test" needed. When I try to verify the Gmail API it requires a domain which I don't have. This is run under a single user xxx#gmail with owner permission from my disk. After seeing Resca's post, I think I may be over doing the OAuth.
I am not a programmer, but have vintage experience with assembler, macro and micro code, but not high level languages. Self taught VBA/Excel
I got parts of this code from "Jean-François Corbett" # https://stackoverflow.com Tonyyy at MRexcel.com
Set CDO_Mail = CreateObject("CDO.Message")
On Error GoTo Error_Handling
Set CDO_Config = CreateObject("CDO.Configuration")
CDO_Config.Load -1
Set SMTP_Config = CDO_Config.Fields
With SMTP_Config
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxxx#gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxx"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
'25 & 465 are valid ports and sometimes may fail. Change to the other if you can't connect
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Update
End With
With CDO_Mail
Set .Configuration = CDO_Config
End With
CDO_Mail.Subject = strSubject
CDO_Mail.From = strFrom
CDO_Mail.To = strTo
CDO_Mail.TextBody = strBody
CDO_Mail.CC = strCc
CDO_Mail.BCC = strBcc
CDO_Mail.Send
To be clear Google did not add Oauth2. The option of using Xoauth2 with the smtp server has always been there. Nor is google forcing you to use Xoauth2 with the smtp server.
What google did was remove the option for Less secure apps & your Google Account. Which allowed you to use the google account password to connect to the smtp server.
If you have 2fa enabled on the google account you can create an apps password and use that password instead of the actual password for the google account in your code.
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "AppsPassword"
If you do not want to use an apps password then yes you will need to configure Xoauth2. xoauth2-protocol Its been a very long time since i have touched VBA I dont think this is something i can help with. But a quick google search shows it should be supported Oauth

Outlook VBA not returning CurrentUser Recipient object on some Windows 10 machines

My work have started to roll out a new set of Lenovo ThinkCentre Windows 10 PCs. The issue is that on some models (but not all) my attempt to get the user's email address from Outlook fails due to Application.Session.CurrentUser not containing any information. If I could figure out a solution to this or a different method of obtaining the email address then I would be happy.
Here is the code that worked fine until they started installing new computers a few weeks ago:
Dim outApp As Object, outSession As Object
Set outApp = CreateObject("Outlook.Application")
Set outSession = outApp.Session.CurrentUser ' BREAKS HERE
currentuserEmailAddress = outSession.AddressEntry.GetExchangeUser().PrimarySmtpAddress
Set outApp = Nothing
End Function
On these new systems, attempting to run the code will throw runtime error 287 at the commented line. Adding outApp to the watchlist on a newer system shows that the CurrentUser object is null. On my PC I can expand out the CurrentUser object to see its properties, etc. but on the newer ones it is not expandable and just shows "<>" under the Value column.
I've raised a question with our tech support guys, but I had to explain to them the difference between a VGA cable and a DisplayPort cable the other day, so I'm not holding my breath there.
Try to check out the Accounts collection instead:
Namespace.Accounts.Item(1).SmtpAddress
Anyway, the runtime error 287 states that you triggered a security issue when dealing with the Outlook object model. To bridge the gap with the security issues you can:
Use a low-level API on which Outlook is based on - Extended MAPI. Also, you may consider using any third-party wrappers around this API such as Redemption.
Use components designed for turning off such issues. See Security Manager for Microsoft Outlook.
Set up any valid antivirus software.
Deploy a group policy to suppress such triggers in the OOM.
Application.Session can be null until you log to a profile. Change your code to
Dim outApp As Object, outSession As Object, outNamespace
Set outApp = CreateObject("Outlook.Application")
Set outNamespace = outApp.GetNamespace("MAPI")
outNamespace.Logon
Set outSession = outApp.Session.CurrentUser
Also keep in mind that GetExchangeUser() can return null for a non-Exchange user - your need to check for that.

How do I change ReceivedTime of emails in Outlook VBA? It says it is write-protected

I am new to VBA and also new here.
Background:
I have just migrated some users from an IMAP server to Exchange. Everything went well except for one user that uses Apple mail app in MacOS. I moved within that app but the sent messages got messed up. The mail app sets the current time as the received time. The mail app and the maiapp in iPhone also uses this timestamp for sorting. So, now I have to find a way to change the received time to the sent time.
I found an answer here:
https://vox.veritas.com/t5/Enterprise-Vault/EV-is-it-possible-to-change-the-date-when-an-email-was-journaled/td-p/590495
I modified it slightly. The error I get is that Item.ReceivedTime is write-protected. How do I get around this?
Sub sent-received()
Set rSession = CreateObject("Redemption.RDOSession")
rSession.MAPIOBJECT = Application.Session.MAPIOBJECT
Set Msg = Application.ActiveExplorer.CurrentFolder
For Each Item In Msg.Items
Item.ReceivedTime = Item.SentOn
Item.Save
Next
End Sub

VBA Lotus Notes sender email address as CC

I created a makro in excel to send all TODOs to the responsible people. Now I want to add the sender address into the CC. I know how to set the CC but I don't know how to get the current sender address.
Set session = CreateObject("Notes.NotesSession")
Set db = session.GETDATABASE("", "")
Call db.OPENMAIL
Set doc = db.CREATEDOCUMENT
Call doc.REPLACEITEMVALUE("CopyTo", strEmail)
I think it should work with the notes session, but I didn't find any method for this.
You can just use NotesSession.UserName(). This is Notes mail you are sending. You don't need a full SMTP-style address with the # and the DNS domain name. You can just put the user's Notes username in an addressing field and the Domino router will do the lookup and it will just work.
The above is true as long as (a) the server that you have established the session with is either the user's home mail server, a member of the same Notes domain (which is not the same thing as a DNS domain), or a member of a Notes domain that includes the user's Notes domain as part of its Directory Assistance (or its cascading address book list if it's using 20-year-old configurations), and (b) the username is unique within the above scope.
another suggestion, copy sender from last sent mail, to test
Set view = db.GetView("(($Sent))")
Set sentdoc = View.GetLastDocument
sender=sentdoc.getItemValue("From")
The way I automated Lotus Notes and sending emails was using this site below:
Send files using Lotus Notes
The area you want to pay attention to is at the bottom, which takes "noDocument" and adds the relevant titles "Subject", "to", "Sendto" etc.
'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipients
.CopyTo = vaCopyTo
.Subject = stSubject
.Body = vaMsg
.SaveMessageOnSend = True
.PostedDate = Now()
.Send 0, vaRecipients
End With
Use NotesSession.userName() to get the current username. If you really want the full email address you might also be able use #namelookup formula.
However, I would stay away from accessing notes via COM as it does not work on 64bit and IBM couldn't care less about it. I had several excel files which used this handy technique, but they are all broken since we moved to 64bit. Check this old kb https://www-304.ibm.com/support/docview.wss?uid=swg21454291

lotus notes to VBA

I'm stuck with this problem for days
I have to read a specific mailbox in lotus notes and bring all the content into an excel spread sheet
but so far I have only been able to read the default inbox and have no way of switching to the other mailbox. I 'm really new to VBA can any one help me sort this out
here is the code I 'm using
Set NSession = CreateObject("Notes.NotesSession")
'get the name of the mailfile of the current user
DbLocation = NSession.GETENVIRONMENTSTRING("mail/mailbox", True)
'Get the notesdatabase for the mail.
Set NMailDb = NSession.GETDATABASE("mailboxer", DbLocation)
MsgBox (DbLocation)
I get an empty msgbox poping up
GetEnvironmentString() reads the notes.ini file. I'm not sure that's what you really want to be doing. Just from the syntax, I think you're using "mail/mailbox" as a placeholder for the actual path to the mailbox that you're looking for. E.g., you're really trying to read the mail from something like "mail/jsmith.nsf". (If I'm wrong, and you really do want to be reading the notes.ini file to get the location of the mail file, then your problem is that "mail/mailbox" is not a valid key for an ini file entry.)
My next assumption is that the Domino server where the mailbox lives is called "mailboxer", because that's what you're putting in the first argument of GetDatabase().
If I'm right about these things, then what what you need is
Set NMailDb = NSession.GETDATABASE("mailboxer", "mail/mailbox")
where "mail/mailbox" is replaced with the actual path to the mailbox that you are trying to open.
Some thoughts:
use Lotus.NotesSession if you don't have to interact with the Notes UI (Lotus.NotesSession is COM based, whereas Notes.NotesSession is OLE based)
make sure the user of the Notes client on the workstation running your VBA application has the rights require to open and read the mailbox
As D. Bugger stated, you need to be sure you have the Notes client installed on the same client machine your VB code will run, and you need to be sure the folder with the nnotes.exe file and the folder with the notes.ini file are in your environment path. (If not, you will get a COM error instantiating the Notes.NotesSession object.
If this helps, here is some starter code - not tested, but a rough guide... This walks through all documents in a Notes mailbox database, ignores anything except email documents (which have the form field = "Memo") and grabs some fields from each email.
Public Sub exportNotesMail(MailServer$, MailDBPath$)
Dim mailDb As Object, doc As Object, alldocs As Object, Session As Object
Set Session = CreateObject("Notes.NotesSession")
Set mailDb = Session.GETDATABASE(MailServer, MailDbPath$)
If mailDb.IsOpen = False Then mailDb.OPENMAIL
Set alldocs = mailDb.AllDocuments
Set doc = alldocs.GetFirstDocument
while not (doc is nothing)
If doc.GetItemValue("Form")(0) = "Memo" Then
thisSubject = doc.getItemValue("Subject")(0)
thisFrom = doc.getItemValue("From")(0)
' get more field values
' Export to Excel or wherever
End If
Set doc = alldocs.GetNextDocument(doc)
Next i
' done
End Sub
call exportNotesMail ("MyServer", "mail\myMailFile.nsf")