sending an email from a form in access 2019 to outlook 365 (1 Viewer)

[Sam Summers]

I had all this working perfectly from outlook before we swapped over to outlook 365.

So from the form frmPO i have this code:

Private Sub OrderValue_AfterUpdate()

    Dim mailTo As String
    Dim Body As String
    Dim Subject As String
 '   Dim attch As String
    Dim lngWhite As Long

    If Nz(Me.OtherField, "") = "" Or Nz(Me.SiteID.Value, "") = "" Or Nz(Me.OrderedForID.Value, "") = "" Then
        MsgBox "You must enter a Description, Location and who ordered for", _
            vbOKOnly Or vbInformation, "Information required"
        Exit Sub
    End If
    
    If Me.OrderValue > 500 Then
          
        MsgBox "Your order is above the threshold and has been sent for approval ", _
            vbOKOnly Or vbInformation, "Approval required"
            
        Forms!frmPO!SupplierSubform.Form!Body.SetFocus
        Forms!frmPO!SupplierSubform.Form!Body.Text = ""
            
        Me.ApprovalCode.SetFocus
        
    Dim mail    As CDO.Message
    Dim config  As CDO.Configuration
    
    Set mail = CreateObject("CDO.Message")
    Set config = CreateObject("CDO.Configuration")
    
    config.Fields(cdoSendUsingMethod).Value = cdoSendUsingPort
    config.Fields(cdoSMTPServer).Value = "mail.summer-isles.com"
    config.Fields(cdoSMTPServerPort).Value = 25
    config.Fields.Update
    
    Set mail.Configuration = config
    
    With mail
        .To = "sam.s@summer-isles.com"
     '   .From = ""
        .Subject = "Request for approval. " & " Approval Code - " & Me.ApprovalCode.Text
        .TextBody = "Please can you approve this order of " & Me.OtherField & " for " & Me.SiteID.Column(1) & " to the value of £" & Me.OrderValue
        .Send
    End With
    
    Set config = Nothing
    Set mail = Nothing
        
'        mailTo = "sam.s@summer-isles.com"
'        Subject = "Request for approval. " & " Approval Code - " & Me.ApprovalCode.Text
'        Body = "Please can you approve this order of " & Me.OtherField & " for " & Me.SiteID.Column(1) & " to the value of £" & Me.OrderValue
'
'        Call SendEmailWithOutlook2(mailTo, Subject, Body)
        DoCmd.RunCommand acCmdSaveRecord
        DoCmd.Close
    Else
    
     '   Me.PODate.Enabled = True
     '   Me.OrderedBy.Enabled = True
        Me.Approved.Visible = True
        Me.Label49.Visible = True
        Me.Approved.Value = True
        Me.PONumber.Visible = True
        lngWhite = RGB(255, 255, 255)
        Me!PONumber.ForeColor = lngWhite
      '  Me.PODate.SetFocus
        
    End If

End Sub

But the above code is producing the error - 8004020d I dont want to use the From field as that is not necessary.

I was using this Function before:

Public Function SendEmailWithOutlook2()

    Dim strTo As String
    Dim strMessage As String
    Dim Subject As String
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim strBody As String
    Dim strEmail As String
    Dim strSubject As String
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)

                Set OutMail = OutApp.CreateItem(olMailItem)
                strEmail = strTo
                strBody = strMessage

        strTo = "sam.s@summer-isles.com"
        strSubject = "Request for approval. " & " Approval Code - " & Me.ApprovalCode.Text
        strMessage = "Please can you approve this order of " & Me.OtherField & " for " & Me.SiteID.Column(1) & " to the value of £" & Me.OrderValue

        With OutMail
        .To = strTo
   '     .Attachments.Add strAttachment
   '     .CC = "djh902@gmail.com"
        .Subject = strSubject
        .Body = strBody
        .Send       ' Send the message immediately
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

End Function

But this now does no longer work.

Can anyone see any glaring issues?

Many thanks as always.

Sam

 

[CJ_London]

No idea what error 8004020d is - please provide the error description as well

But looks like you are mixing early binding and late binding.

For example since you have already have early binding here (and I presume you have set outlook in references to the correct version)

Dim OutApp As Outlook.Application

you don't need late binding here

Set OutApp = CreateObject("Outlook.Application")

Personally I prefer late binding so the app will use whatever version of outlook is available -in which case you would use

Dim OutApp As Object
Set OutApp = CreateObject("Outlook.Application")

but you do use lose intellisense with late binding

 

[Gasman]

Have you walked through the code?
It looks like a To field should be set from your code?

CDO.Message.1 error '8004020d'
At least one of the From or Sender fields is required, and neither was found.

 

[arnelgp]

maybe this has the answer for you:
CDO.Message.1 error '8004020d' - CodeProject

 

[Sam Summers]

Ok so walking through the afterUpdate code section it fails at the .send with the error -
CDO.Message.1 error '8004020d'
At least one of the From or Sender fields is required, and neither was found

I dont have a clue whats going on?

 

[Sam Summers]

maybe this has the answer for you:
CDO.Message.1 error '8004020d' - CodeProject

I looked at that earlier Arnel and i'm just as confused but i'll take another look

 

[Gasman]

TBH I would have thought you would need a To, a From and a Subject at the least?

 

[Sam Summers]

TBH I would have thought you would need a To, a From and a Subject at the least?

I dont know how i could have a from because its a multiuser database so always someone different?
I suppose if i had to i could make a field for each users email address?

 

[Gasman]

I dont know how i could have a from because its a multiuser database so always someone different?
I suppose if i had to i could make a field for each users email address?

Just have a generic email address, as you have hardcoded yours?
info@@summer-isles.com

Outlook would always have a From address as you would tend to use the default account?

 

[Sam Summers]

Just have a generic email address, as you have hardcoded yours?
info@@summer-isles.com

Outlook would always have a From address as you would tend to use the default account?

I never had to use it before but the To address will always be the same person/people but from will always be different.
As i said it all worked fine up until the company switched to online outlook 365

 

[Gasman]

SSAFA gave all volunteers an online 365 account with outlook, word etc.
That meant I was not able to use my db anymore for keeping caseworkers uptodate.
Whilst you can use it from outlook on your pc like gmail, that has to be allowed, and SSAFA would not allow that. Online emails only, which made the work even longer.
As I mentioned, using outlook, would have used each users default a/c unless specified differently.
It would not hurt to try , just using your address, as a test if nothing else?

 

[Sam Summers]

SSAFA gave all volunteers an online 365 account with outlook, word etc.
That meant I was not able to use my db anymore for keeping caseworkers uptodate.
Whilst you can use it from outlook on your pc like gmail, that has to be allowed, and SSAFA would not allow that. Online emails only, which made the work even longer.
As I mentioned, using outlook, would have used each users default a/c unless specified differently.
It would not hurt to try , just using your address, as a test if nothing else?

Yeah, it isn't hard to do.
I will see what i can do and reply here.
Thank you

 

[Sam Summers]

Just trying this at the moment but it fails at the line 70 - Call SendEmailWithOutlook2(MessageTo, Subject, MessageBody)
Saying Type Mismatch?

Private Sub OrderValue_AfterUpdate()

    Dim MessageTo As String
    Dim Subject As String
    Dim MessageBody As String
'    Dim mailTo As String
'    Dim TextBody As String
'    Dim Subject As String
 '   Dim attch As String
    Dim lngWhite As Long
        ' Define app variable and get Outlook using the "New" keyword
    Dim olApp As New Outlook.Application
    Dim olEmail As Outlook.MailItem  ' An Outlook Mail item

    If Nz(Me.OtherField, "") = "" Or Nz(Me.SiteID.Value, "") = "" Or Nz(Me.OrderedForID.Value, "") = "" Then
        MsgBox "You must enter a Description, Location and who ordered for", _
            vbOKOnly Or vbInformation, "Information required"
        Exit Sub
    End If
    
    If Me.OrderValue > 500 Then
          
        MsgBox "Your order is above the threshold and has been sent for approval ", _
            vbOKOnly Or vbInformation, "Approval required"
            
        Forms!frmPO!SupplierSubform.Form!Body.SetFocus
        Forms!frmPO!SupplierSubform.Form!Body.Text = ""
            
        Me.ApprovalCode.SetFocus
        
'        ' Create a new email object
'    Set olEmail = olApp.CreateItem(olMailItem)
'
'        ' Add the To/Subject/Body to the message and display the message
'    With olEmail
'        .To = "sam.s@summer-isles.com"
'        .Subject = "Request for approval. " & " Approval Code - " & Me.ApprovalCode.Text
'        .Body = "Please can you approve this order of " & Me.OtherField & " for " & Me.SiteID.Column(1) & " to the value of £" & Me.OrderValue
'        .Send       ' Send the message immediately
'    End With
        
'    Dim mail    As CDO.Message
'    Dim config  As CDO.Configuration
'
'    Set mail = CreateObject("CDO.Message")
'    Set config = CreateObject("CDO.Configuration")
'
'    config.Fields(cdoSendUsingMethod).Value = cdoSendUsingPort
'    config.Fields(cdoSMTPServer).Value = "mail.summer-isles.com"
'    config.Fields(cdoSMTPServerPort).Value = 25
'    config.Fields.Update
'
'    Set mail.Configuration = config
'
'    With mail
'        .To = "sam.s@summer-isles.com"
'     '   .From = ""
'        .Subject = "Request for approval. " & " Approval Code - " & Me.ApprovalCode.Text
'        .TextBody = "Please can you approve this order of " & Me.OtherField & " for " & Me.SiteID.Column(1) & " to the value of £" & Me.OrderValue
'        .Send
'    End With
'
'    Set config = Nothing
'    Set mail = Nothing
        
'        mailTo = "sam.s@summer-isles.com"
'        Subject = "Request for approval. " & " Approval Code - " & Me.ApprovalCode.Text
'        Body = "Please can you approve this order of " & Me.OtherField & " for " & Me.SiteID.Column(1) & " to the value of £" & Me.OrderValue
'
        Call SendEmailWithOutlook2(MessageTo, Subject, MessageBody)
        DoCmd.RunCommand acCmdSaveRecord
        DoCmd.Close
    Else
    
     '   Me.PODate.Enabled = True
     '   Me.OrderedBy.Enabled = True
        Me.Approved.Visible = True
        Me.Label49.Visible = True
        Me.Approved.Value = True
        Me.PONumber.Visible = True
        lngWhite = RGB(255, 255, 255)
        Me!PONumber.ForeColor = lngWhite
      '  Me.PODate.SetFocus
        
    End If

End Sub

Here is the SendEmailWithOutlook2 Function:

Public Function SendEmailWithOutlook2()

    Dim strTo As String
    Dim strMessage As String
    Dim Subject As String
    Dim OutApp As Object
    Dim OutMail As Object  ' An Outlook Mail item
    Dim strBody As String
    Dim strEmail As String
    Dim strSubject As String
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)

                Set OutMail = OutApp.CreateItem(olMailItem)
                strEmail = strTo
                strBody = strMessage

        strTo = "sam.s@summer-isles.com"
        strSubject = "Request for approval. " & " Approval Code - " & Me.ApprovalCode.Text
        strMessage = "Please can you approve this order of " & Me.OtherField & " for " & Me.SiteID.Column(1) & " to the value of £" & Me.OrderValue

        With OutMail
        .To = strTo
   '     .Attachments.Add strAttachment
   '     .CC = "djh104@gmail.com"
        .Subject = strSubject
        .Body = strBody
        .Send       ' Send the message immediately
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

End Function

 

[Gasman]

I thought you were trying to used CDO?

That function has no parameters, yet you are passing some?
I have seen the opposite before, but not that.

 

[Sam Summers]

I thought you were trying to used CDO?

That function has no parameters, yet you are passing some?
I have seen the opposite before, but not that.

I'm just trying anything to find something that works but i don't understand it and even more confused after it was all working fine before 365?

 

[Gasman]

Ok. This is my understanding.
When it was working before 365, you were using Outlook? and some or all of that Outlook code.?
Then when company changed to 365 you had to go with CDO.? Has that ever worked after going to CDO?

As I mentioned, if the 365 is not setup for client access (like SSAFA had it set up) then Outlook is not going to work, even if you know the server names and ports. So I seem to recall from a previous thread, you went to CDO. ?

Now has CDO ever worked in the past? If it has, what has changed since it was initially working?

No good trying things via the buckshot method. Try one thing at a time and make a note of what you have tried. Have some method to try and identify where the fault lies.

You are passing parameters to that function, yet the function does not expect any paramters. If it should have some, then put them in the Function declaration as normal.
As I mentioned, I have not seen a call with parameters, to a function that does not expect any. I have see the reverse and then it complains sometimes, but generally the values are just missing.

So make you mind up which approach to use. Does the Outlook function need parameters?

You are setting variables from other variables that have no value yet? You set those later in the code.

                strEmail = strTo
                strBody = strMessage

Fortunately for you, you again set them further down the code again, but you need to understand that.

 

[Gasman]

I just tried what you appear to be doing and got this error

Sub tesCall()
Call GetDBPath("test")

End Sub

Public Function GetDBPath() As String

 

[Sam Summers]

Ok. This is my understanding.
When it was working before 365, you were using Outlook? and some or all of that Outlook code.?
Then when company changed to 365 you had to go with CDO.? Has that ever worked after going to CDO?

As I mentioned, if the 365 is not setup for client access (like SSAFA had it set up) then Outlook is not going to work, even if you know the server names and ports. So I seem to recall from a previous thread, you went to CDO. ?

Now has CDO ever worked in the past? If it has, what has changed since it was initially working?

No good trying things via the buckshot method. Try one thing at a time and make a note of what you have tried. Have some method to try and identify where the fault lies.

You are passing parameters to that function, yet the function does not expect any paramters. If it should have some, then put them in the Function declaration as normal.
As I mentioned, I have not seen a call with parameters, to a function that does not expect any. I have see the reverse and then it complains sometimes, but generally the values are just missing.

So make you mind up which approach to use. Does the Outlook function need parameters?

You are setting variables from other variables that have no value yet? You set those later in the code.

                strEmail = strTo
                strBody = strMessage

Fortunately for you, you again set them further down the code again, but you need to understand that.

Thank you!
Great explanation.

Basically I just attempted to run the same form again after a while and it didnt work so now i am trying to get it working.
So i have not managed to get it working since we changed to 365.

I will have another go at it over the next two days, following your advice.

 

[Gasman]

Well my thoughts would be to get the CDO working. Add your email address as the From and try that.
SImplest and quickest test to try.

 

[Sam Summers]

Well my thoughts would be to get the CDO working. Add your email address as the From and try that.
SImplest and quickest test to try.

So now i have this:

    Dim mailserver As String
    Dim SMTPport As Integer
    Dim mailusername As String
    Dim mailpassword As String
    Dim mailTo As String
    Dim mailsubject As String
    Dim mailBody As String
    
    Dim objEmail, objConf, objFlds

    Const cdoSendUsingPort = 2  ' Send the message using SMTP
    Const cdoBasicAuth = 1      ' Clear-text authentication
    Const cdoTimeout = 60       ' Timeout for SMTP in seconds

     mailserver = "smtp.office365.com"
     SMTPport = 465     '25 'SMTPport = 465
     mailusername = "sam.s@summer-isles.com"
     mailpassword = "Di*******"

     mailTo = "sam.s@summer-isles.com"
     mailsubject = "my test-deleteme"
     mailBody = "This is the email body"

    Set objEmail = CreateObject("CDO.Message")
    Set objConf = objEmail.Configuration
    Set objFlds = objConf.fields

    With objFlds
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mailserver
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTPport
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = cdoTimeout
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasicAuth
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mailusername
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mailpassword
        .Update
    End With

    objEmail.To = mailTo
    objEmail.From = mailusername
    objEmail.Subject = mailsubject
    objEmail.TextBody = mailBody
    'objEmail.AddAttachment "C:\report.pdf"
    objEmail.Send

    Set objFlds = Nothing
    Set objConf = Nothing
    Set objEmail = Nothing

But i am getting this error message: