Send email via GMail (1 Viewer)

TimTDP

Registered User.
Local time
Today, 04:47
Joined
Oct 24, 2008
Messages
210
I need to send email using GMail and have the following code:
Code:
Public Sub SendEmailGmail()
    
Dim NewMail As CDO.Message
Dim mailConfig As CDO.Configuration
Dim fields As Variant
Dim msConfigURL As String
Dim db As DAO.Database
Dim rstAttachments As DAO.Recordset
Dim rstGmailSettings As DAO.Recordset
    
On Error GoTo Err:

Set NewMail = New CDO.Message
Set mailConfig = New CDO.Configuration

' load all default configurations
mailConfig.Load -1

Set fields = mailConfig.fields

Set db = CurrentDb()
Set rstGmailSettings = db.OpenRecordset("Select * from tblCompanyGmailSettings")

'Set All Email Properties
With NewMail
    .Sender = rstGmailSettings!SendUserName
    .From = DLookup("CompanyName", "tblCompanyDetails")
    .To = Left(pubEmailToAddress, Len(pubEmailToAddress) - 1)
    .CC = ""
    .BCC = ""
    .Subject = pubEmailSubject
    .Textbody = pubEmailBody
    'Add Attachments
    Set rstAttachments = db.OpenRecordset("Select EMailAttachment from tblTempSendEMailAttachments")
    
    If rstAttachments.RecordCount > 0 Then
        With rstAttachments
            .MoveLast
            .MoveFirst
            Do Until .EOF
                .AddAttachment rstAttachments!EMailAttachment
                .MoveNext
            Loop
        End With
    End If
End With

msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

With fields
    .Item(msConfigURL & "/smtpusessl") = rstGmailSettings!SmtpUseSsl            'Enable SSL Authentication
    .Item(msConfigURL & "/smtpauthenticate") = rstGmailSettings!SmtpAuthenticate        'SMTP authentication Enabled
    .Item(msConfigURL & "/smtpserver") = rstGmailSettings!SmtpServer 'Set the SMTP server details
    .Item(msConfigURL & "/smtpserverport") = rstGmailSettings!SmtpServerPort          'Set the SMTP port Details
    .Item(msConfigURL & "/sendusing") = rstGmailSettings!SendUsing                 'Send using default setting
    .Item(msConfigURL & "/sendusername") = rstGmailSettings!SendUserName 'Your gmail address
    .Item(msConfigURL & "/sendpassword") = rstGmailSettings!SendPassword 'Your password or App Password
    .Update                                               'Update the configuration fields
End With
NewMail.Configuration = mailConfig
NewMail.Send

'MsgBox "Your email has been sent", vbInformation

Exit_Err:
    'Release object memory
    Set NewMail = Nothing
    Set mailConfig = Nothing
    CloseRecordSet rstAttachments
    CloseRecordSet rstGmailSettings
    Set db = Nothing
    
    End

Err:
    Select Case Err.Number
    Case -2147220973  'Could be because of Internet Connection
        MsgBox "Check your internet connection." & vbNewLine & Err.Number & ": " & Err.Description
    Case -2147220975  'Incorrect credentials User ID or password
        MsgBox "Check your login credentials and try again." & vbNewLine & Err.Number & ": " & Err.Description
    Case Else   'Report other errors
        MsgBox "Error encountered while sending email." & vbNewLine & Err.Number & ": " & Err.Description
    End Select

    Resume Exit_Err

End Sub

I need to allow for multiple file attachments,
I put the file to attach in the table ”tblTempSendEMailAttachments”
And included included the the loop:
Code:
If rstAttachments.RecordCount > 0 Then
   With rstAttachments
      .MoveLast
      .MoveFirst
      Do Until .EOF
         .AddAttachment rstAttachments!EMailAttachment
         .MoveNext
      Loop
   End With
End If
But I get the error "Method or data member not found" on line .AddAttachment rstAttachments!EMailAttachment, with .AddAttachment highlighted
How do I overcome this?

I am not adverse to using better code that get's the job done!

Thanks in advance
 

Users who are viewing this thread

Top Bottom