Problem with cdo message

**diegomarino** · 11-12-2020, 08:45 AM

hi,
i want to send emails with vba, but i want to use my company email so i studied a lot of stuff about CDO message, but surely i miss something.

this is the code i found

Code:

Function SendMail(StrFrom As StringStrTO As String, StrSubject As String, StrTextBody As String, Optional StrCC As String, Optional StrBcc As String, Optional StrAttachDoc As String, Optional blnHighPriority As Boolean = False)

   DIM objMessage As Object   
   Set objMessage = New CDO.Message


   With objMessage
   .From = StrFrom
   .To = StrTO
   
   If Len(Trim$(StrCC)) > 0 Then
      .CC = StrCC
   End If
   
   If Len(StrBcc) > 0 Then
      .Bcc = StrBcc
   End If


   If blnHighPriority Then
      With .Fields
         ' for Outlook:
         .Item(cdoImportance) = cdoHigh
         .Item(cdoPriority) = cdoPriorityUrgent


         .Update
      End With
   End If
 
   .Subject = StrSubject
    
   If InStr(UCase(StrTextBody), "<HTML>") Or InStr(UCase(StrTextBody), "</HTML>") Then
      .HTMLBody = StrTextBody
   Else
      .TextBody = StrTextBody
   End If
   
   If Len(StrAttachDoc) > 0 Then
      .AddAttachment StrAttachDoc
   End If


   With .Configuration.Fields
        .Item(CDO.cdoSMTPServer) = "authsmtp.securemail.pro"
        .Item(CDO.cdoSMTPServerPort) = 25
        .Item(CDO.cdoSendUsingMethod) = cdoSendUsingPort
        .Item(cdoSMTPConnectionTimeout) = 10
        .Update
    End With
    .Send
End With


Set objMessage = Nothing


End Function

this is the call of the function

Code:

Private Sub SendMailBtn_Click()   Call SendMail("diego.maradona@maradona.it", "diegomaradona@yahoo.it",  "hello", "lalo")
   DoCmd.Close acForm, "invio mail"
End Sub

i have an errore "account must be authenticated"

i just found the CDO sistem so i have no clue about the error.

ps is it possible to open outlook with the prepared mail instead of sending it?

**isladogs** · 11-12-2020, 10:03 AM

There are some issues with your code
See if my example app helps: CDO EMail Tester. It includes a help file that covers all possible errors that may occur if your settings are incorrect

CDO is normally used to send email from Access without involving Outlook.
If you want to view the email in Outlook first, it is possible to do so. However, I would suggest not using CDO in that case

**diegomarino** · 11-12-2020, 10:39 AM

thanks, i've already seen your test db.
however, right now i use this code

Code:

Sub SendMail(MailSubject As String, MailRecipient As String, MailBody As String, MailTitolo As String)

   Dim olapp As Outlook.Application
   Dim olMail As Outlook.MailItem
   
   'get application
   On Error Resume Next
   Set olapp = GetObject(, "Outlook.Application")
   If olapp Is Nothing Then Set olapp = New Outlook.Application
   On Error GoTo 0
   
   Set olMail = olapp.CreateItem(olMailItem)
   With olMail
   .Subject = MailSubject
   .Recipients.Add MailRecipient
   If FileAttach <> "" Then
      .Attachments.Add FileAttach
   End If
   .Body = MailBody
   .display 'This will display the message for you to check and send yourself
   '.Send ' This will send the message straight away
   End With
   FileAttach = ""
End Sub

outlook opens but with the wrong "from" email, it will be enough for now (i'm not expert) if i could select the default mail in the outlook program

**Gicu** · 11-12-2020, 11:03 AM

If you have multiple mailboxes set up in your Outlook you may want to use SendOnBehalfOf:
https://www.slipstick.com/developer/...l-address-vba/
Cheers,

**diegomarino** · 11-12-2020, 11:26 AM

thanks for your answer
i've already tried this method, however i added to the code now but outlook uses always the default mail unfortunely...

Code:

Sub SendMail(MailSubject As String, MailRecipient As String, MailBody As String, MailTitolo As String)

   Dim olapp As Outlook.Application
   Dim olMail As Outlook.MailItem
   
   'get application
   On Error Resume Next
   Set olapp = GetObject(, "Outlook.Application")
   If olapp Is Nothing Then Set olapp = New Outlook.Application
   On Error GoTo 0
   
   Set olMail = olapp.CreateItem(olMailItem)
   With olMail
   .SUBJECT = MailSubject
   .Recipients.Add MailRecipient
   .SentOnBehalfOfName = "diego.maradona@ml.it"
   If FileAttach <> "" Then
      .Attachments.Add FileAttach
   End If
   .Body = MailBody
   .display 'This will display the message for you to check and send yourself
   '.Send ' This will send the message straight away
   End With
   FileAttach = ""
End Sub

**Gicu** · 11-12-2020, 11:33 AM

Is your other mailbox loaded into your Outlook? You can try to specify the account, have a look at the "Macro using a specific account" in this link
https://www.slipstick.com/developer/...cific-account/

Cheers,
Vlad

**diegomarino** · 11-12-2020, 12:25 PM

i'm triyng to integrate the two codes

Code:

Sub SendMail(MailSubject As String, MailRecipient As String, MailBody As String, MailTitolo As String)

   Dim olapp As Outlook.Application
   Dim olMail As Outlook.MailItem


   Dim oAccount As Outlook.Account


   For Each oAccount In Application.Session.Accounts
      If oAccount = "diego.marino@mideal.it" Then
         Set olMail = Application.CreateItem(olMailItem)
         With olMail
            .SUBJECT = MailSubject
            .Recipients.Add MailRecipient
            If FileAttach <> "" Then
               .Attachments.Add FileAttach
            End If
            .Body = MailBody
            oMail.SendUsingAccount = oAccount
            oMail.Display
            .Display 'This will display the message for you to check and send yourself
            .Send ' This will send the message straight away
            End With
            FileAttach = ""
      End If
   Next
 
   'get application
'   On Error Resume Next
'   Set olapp = GetObject(, "Outlook.Application")
'   If olapp Is Nothing Then Set olapp = New Outlook.Application
'   On Error GoTo 0
'
'   Set olMail = olapp.CreateItem(olMailItem)
'   With olMail
'   .SUBJECT = MailSubject
'   .Recipients.Add MailRecipient
'   .SentOnBehalfOfName = "diego.marino@mideal.it"
'   If FileAttach <> "" Then
'      .Attachments.Add FileAttach
'   End If
'   .Body = MailBody
'   .Display 'This will display the message for you to check and send yourself
'   '.Send ' This will send the message straight away
'   End With
'   FileAttach = ""

i have an error "cannot find method or member of data" and highlights "Application.Session.Accounts"

**Welshgasman** · 11-12-2020, 01:01 PM

Use the required account. In this case intAccount is a number which represents the order of the accounts in Outlook.

Code:

.SendUsingAccount = objOutlook.Session.Accounts.Item(intAccount)

Code:

Public Function ListEMailAccounts(AcctToUSe As String) As Integer
    Dim outApp As Object
    Dim i As Integer
    Dim AccNo As Integer
    Dim emailToSendTo As String
    
    Set outApp = CreateObject("Outlook.Application")
    'emailToSendTo = "xxxxxxxl@gmail.com"                    'put required email address
    AccNo = 1
    'if smtp address=email we want to send to, acc no we are looking for is identified
    For i = 1 To outApp.Session.Accounts.Count
        'Uncomment the Debug.Print command to see all email addresses that belongs to you
'Debug.Print "Acc name: " & OutApp.Session.Accounts.Item(i) & " Acc number: " & i & " , email: " & OutApp.Session.Accounts.Item(i).SmtpAddress
        'If OutApp.Session.Accounts.Item(i).SmtpAddress = emailToSendTo Then
        If outApp.Session.Accounts.Item(i).DisplayName = AcctToUSe Then

            AccNo = i
            Exit For
        End If
    Next i
    ListEMailAccounts = AccNo
    Set outApp = Nothing
End Function

**diegomarino** · 11-12-2020, 04:38 PM

sorry, i'm confused now. the part below is for what and where?

Code:

.SendUsingAccount = objOutlook.Session.Accounts.Item(intAccount)

then i tried to run this code but nothing happens (i set the "accountToUse" variable to the mail i want to use and emailToSendTo to another mail

Code:

Public Function ListEMailAccounts(AcctToUSe As String) As Integer
    Dim outApp As Object
    Dim i As Integer
    Dim AccNo As Integer
    Dim emailToSendTo As String
    
    Set outApp = CreateObject("Outlook.Application")
    'emailToSendTo = "xxxxxxxl@gmail.com"                    'put required email address
    AccNo = 1
    'if smtp address=email we want to send to, acc no we are looking for is identified
    For i = 1 To outApp.Session.Accounts.Count
        'Uncomment the Debug.Print command to see all email addresses that belongs to you
'Debug.Print "Acc name: " & OutApp.Session.Accounts.Item(i) & " Acc number: " & i & " , email: " & OutApp.Session.Accounts.Item(i).SmtpAddress
        'If OutApp.Session.Accounts.Item(i).SmtpAddress = emailToSendTo Then
        If outApp.Session.Accounts.Item(i).DisplayName = AcctToUSe Then

            AccNo = i
            Exit For
        End If
    Next i
    ListEMailAccounts = AccNo
    Set outApp = Nothing
End Function

[/QUOTE]

sorry but this is the first time i work with emails

**Gicu** · 11-12-2020, 05:08 PM

Hi, can you please try this:

Code:

Sub SendMail(MailSubject As String, MailRecipient As String, MailBody As String, MailTitolo As String)


   Dim olapp As Outlook.Application
   Dim olMail As Outlook.MailItem




   Dim oAccount As Outlook.Account

 'get application
   On Error Resume Next
   Set olapp = GetObject(, "Outlook.Application")
   If olapp Is Nothing Then Set olapp = New Outlook.Application
   On Error GoTo 0
   

 For Each oAccount In olapp.Session.Accounts   'Application.Session.Accounts <<Application in this context refers to Access not Outlook>>
      If oAccount = "diego.marino@mideal.it" Then
         Set olMail = olapp.CreateItem(olMailItem) '<<Application in this context refers to Access not Outlook>>
         With olMail
            .SUBJECT = MailSubject
            .Recipients.Add MailRecipient
            If FileAttach <> "" Then
               .Attachments.Add FileAttach
            End If
            .Body = MailBody
            oMail.SendUsingAccount = oAccount
            oMail.Display
            .Display 'This will display the message for you to check and send yourself
            .Send ' This will send the message straight away
            End With
            FileAttach = ""
      End If
   Next

Cheers,

**diegomarino** · 11-13-2020, 05:51 AM

thank you very much sir, everything works and i finally understood how it works.
i just made little changes (olmail instead of omail and set display true) but now works great

here the correct code

Code:

Sub SendMail(MailSubject As String, MailRecipient As String, MailBody As String, MailTitolo As String)

   Dim olapp As Outlook.Application
   Dim olMail As Outlook.MailItem


   Dim oAccount As Outlook.Account


 'get application
   On Error Resume Next
   Set olapp = GetObject(, "Outlook.Application")
   If olapp Is Nothing Then Set olapp = New Outlook.Application
   On Error GoTo 0


 For Each oAccount In olapp.Session.Accounts   'Application.Session.Accounts <<Application in this context refers to Access not Outlook>>
      If oAccount = "diego.marino@mideal.it" Then
         Set olMail = olapp.CreateItem(olMailItem) '<<Application in this context refers to Access not Outlook>>
         With olMail
            .SUBJECT = MailSubject
            .Recipients.Add MailRecipient
            If FileAttach <> "" Then
               .Attachments.Add FileAttach
            End If
            .Body = MailBody
            olMail.SendUsingAccount = oAccount
            olMail.Display True 'This will display the message for you to check and send yourself
            .Send ' This will send the message straight away
            End With
            FileAttach = ""
      End If
   Next
End Sub

**Gicu** · 11-13-2020, 09:11 AM

Glad to hear you got it working, good luck with your project and stay safe!

Cheers,
Vlad

Problem with cdo message

Thread Tools

Problem with cdo message

Similar Threads

Database Append Problem - Error Message

Problem using Navigation Form-Getting error message when using Find button

Custom BeforeDelConfirm Message Question/Problem

Alert Message Code Problem

Custom error message problem

Posting Permissions