Solved How to send multiple attachment with CDO Gmail in MS Access VBA

N

nector

Member
Local time
Today, 03:16
Joined
Jan 21, 2020
Messages
494
The code below is almost complete of course with the help of the members here or on this forum, all is working fine but with one exception it can only send one attachment at a time. I have managed to attach multiple file as you can see below on the screen shoot, so the challenge is how to send them to the recepients

Code: 
Private Sub Send_btn_Click()
'for early binding, enable tools > References > Microsoft CDO for Windows 2000 Library

Dim Newmail As Object
Dim mailConfig As Object
Dim fields As Variant
Dim msConfigURL As String
Dim varFile As Variant

On Error GoTo Err1:
'late binding
Set Newmail = CreateObject("CDO.Message")
Set mailConfig = CreateObject("CDO.configuration")

mailConfig.Load -1
Set fields = mailConfig.fields

    With Newmail
        .Sender = DLookup("[EmailAddress]", "[tblSpecialcompanyDetails]", "[CompanyID] = 1")
        .From = DLookup("[CompanyName]", "[tblSpecialcompanyDetails]", "[CompanyID] = 1")
        .To = Me.SendTo
        .Subject = Me.Subject
        .TextBody = Me.Message
                       
        End With
If Not Attachment = "" Then
    With Newmail
        .AddAttachment Me.Attachment
       
       
    End With
    End If
   
If (Me.Cc <> "") Then
    With Newmail
        .Cc = Me.Cc
    End With
    End If
   

msConfigURL = "http://schemas.microsoft.com/cdo/configuration"
    With fields
        .item(msConfigURL & "/smtpusessl") = True 'enable the SSL authentication
        .item(msConfigURL & "/smtpauthenticate") = 1
        .item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
        .item(msConfigURL & "/smtpserverport") = 465
        .item(msConfigURL & "/sendusing") = 2
        .item(msConfigURL & "/sendusername") = DLookup("[EmailAddress]", "[tblSpecialcompanyDetails]", "[CompanyID] = 1") 'input your gmail here
        .item(msConfigURL & "/sendpassword") = DLookup("[Password]", "[tblSpecialcompanyDetails]", "[CompanyID] = 1")
        .Update 'update the configuration fields
       
    End With
       
    Newmail.configuration = mailConfig
    Newmail.Send
    MsgBox "Your email has been sent.", vbInformation, "Your Email Has Been Sent Successfully"
    Me.Status = "Sent"
   
Exit_Err1:
'release object memory
Set Newmail = Nothing
Set mailConfig = Nothing
   
   
   
Err1:
    Select Case Err.Number
    Case -2147220973 'due to internet connection
    MsgBox "check your internet connection." & vbNewLine & Err.Number & ": " & Err.Description
   
    Case -2147220975 ' due to incorrect credentials
    MsgBox "Incorrect Credentials." & vbNewLine & Err.Number & ": " & Err.Description
   
    Case 13 'missing information
    MsgBox "Please fill up the required fiels." & vbNewLine & Err.Number & ": " & Err.Description
   
    Case -2146697203 'Invalid link for attachment
    MsgBox "Invalid Link for attachment"
       
        Case Else
        MsgBox "Error encountered while sending and email.", vbCritical, "Unsend"
       
        End Select
        Resume Exit_Err1

On Error Resume Next


End Sub

I need help on this part of the below to allow sending multiple files:

Code: 
If Not Attachment = "" Then
    With Newmail
        .AddAttachment Me.Attachment
       
 End With
 End If



Send Attachments.png
 
For example, if you want to send two attachments you can have two TextBoxes: Attachment1 and Attachment2, and for sendirng both files, you have to change the code:

Code: 
With Newmail
     If Not isNull(Me.Attachment1)  Then
        .AddAttachment Me.Attachment1
     Endif
     If Not isNull(Me.Attachment2)  Then
        .AddAttachment Me.Attachment2
     Endif
End With
 
Use the split function on your attachment field and then loop through the array
 
Its giving me type missmatch

1735647996533.png



Code: 
With Newmail
     If Not IsNull(Me.Attachment(1)) Then
        .AddAttachment Me.Attachment(1)
     End If
     If Not IsNull(Me.Attachment(2)) Then
        .AddAttachment Me.Attachment(2)
     End If
End With
 
@ Use the split function on your attachment field and then loop through the array

I'm a beat lost how do we use this split function
 
You have not made it clear what me.attachment actually is - I assume from your image and description it is this

image_2024-12-31_123629058.png


so your code might be something like this aircode

Code: 
dim a() as string
dim i as integer

if attachment <>"" then

    a=split(attachment,";")
    for i=0 to ubound(a)

        .AddAttachment a(i)

    next i

end if
 
It needs to be within your with newmail group - I.e. above your ‘end with’

Edit - and your dims should be at top of your sub, not within the loop
 
Last edited:
Its now giving me the sending failure message , unless I have changed a wrong place , see the new code

Code: 
Dim Newmail As Object
Dim mailConfig As Object
Dim fields As Variant
Dim msConfigURL As String
Dim a() As String
Dim i As Integer

On Error GoTo Err1:
'late binding
Set Newmail = CreateObject("CDO.Message")
Set mailConfig = CreateObject("CDO.configuration")

mailConfig.Load -1
Set fields = mailConfig.fields

    With Newmail
        .Sender = DLookup("[EmailAddress]", "[tblSpecialcompanyDetails]", "[CompanyID] = 1")
        .From = DLookup("[CompanyName]", "[tblSpecialcompanyDetails]", "[CompanyID] = 1")
        .To = Me.SendTo
        .Subject = Me.Subject
        .TextBody = Me.Message
        .AddAttachment a(i)
                        
        End With

If Attachment <> "" Then

    a = Split(Attachment, ";")
    For i = 0 To UBound(a)

    Next i

End If
If (Me.Cc <> "") Then
    With Newmail
        .Cc = Me.Cc
    End With
    End If
    

msConfigURL = "http://schemas.microsoft.com/cdo/configuration"
    With fields
        .item(msConfigURL & "/smtpusessl") = True 'enable the SSL authentication
        .item(msConfigURL & "/smtpauthenticate") = 1
        .item(msConfigURL & "/smtpserver") = "smtp.gmail.com"
        .item(msConfigURL & "/smtpserverport") = 465
        .item(msConfigURL & "/sendusing") = 2
        .item(msConfigURL & "/sendusername") = DLookup("[EmailAddress]", "[tblSpecialcompanyDetails]", "[CompanyID] = 1") 'input your gmail here
        .item(msConfigURL & "/sendpassword") = DLookup("[Password]", "[tblSpecialcompanyDetails]", "[CompanyID] = 1")
        .Update 'update the configuration fields
        
    End With
        
    Newmail.configuration = mailConfig
    Newmail.Send
    MsgBox "Your email has been sent.", vbInformation, "Your Email Has Been Sent Successfully"
    Me.Status = "Sent"
    
Exit_Err1:
'release object memory
Set Newmail = Nothing
Set mailConfig = Nothing
End
      
    
    
Err1:
    Select Case Err.Number
    Case -2147220973 'due to internet connection
    MsgBox "check your internet connection." & vbNewLine & Err.Number & ": " & Err.Description
    
    Case -2147220975 ' due to incorrect credentials
    MsgBox "Incorrect Credentials." & vbNewLine & Err.Number & ": " & Err.Description
    
    Case 13 'missing information
    MsgBox "Please fill up the required fiels." & vbNewLine & Err.Number & ": " & Err.Description
    
    Case -2146697203 'Invalid link for attachment
    MsgBox "Invalid Link for attachment"
        
        Case Else
        MsgBox "Error encountered while sending and email.", vbCritical, "Unsend"
        
        End Select
        Resume Exit_Err1

On Error Resume Next


End Sub
 
your .AddAttachment a(i) is in the wrong place - why did you move it from where I put it

would help if you lined up your ifs and loops - makes it a lot easier to interprete
Code: 
With Newmail

        .Sender = DLookup("[EmailAddress]", "[tblSpecialcompanyDetails]", "[CompanyID] = 1")
        .From = DLookup("[CompanyName]", "[tblSpecialcompanyDetails]", "[CompanyID] = 1")
        .To = Me.SendTo
        .Subject = Me.Subject
        .TextBody = Me.Message

        If Attachment <> "" Then

            a = Split(Attachment, ";")

            For i = 0 To UBound(a)

                 .AddAttachment a(i)

            Next i

       End If 'attachment

      If (Me.Cc <> "") Then  .Cc = Me.Cc

End With 'newmail
 
Code: 
    Set Newmail = Nothing
    Set mailConfig = Nothing
End                                              <<<<=========


Err1:
    Select Case Err.Number
    Case -2147220973 'due to internet connection
    MsgBox "check your internet connection." & vbNewLine & Err.Number & ": " & Err.Description

If this is a cut/paste of the actual code, then the line I highlighted should not be there. The side effects of an isolated END statement (not END SUB or other "qualified" ENDs) are quite severe. Look at the link below and read the paragraphs about what an END statement REALLY does. (HINT: It is a drastic action that has far-reaching side effects.) I'm thinking you need an EXIT SUB in that location.

learn.microsoft.com

End statement (VBA)

Office VBA reference topic
learn.microsoft.com

Code: 
On Error GoTo Err1:

That colon does not need to be there. In that context, you COULD put another complete VBA statement after the colon, but you don't have another statement in that position, which is why you don't need the colon.

I didn't see the top of your module, but if that WAS the top of the module in your presentation in post #9, you are skipping not one but TWO important declarations - OPTION COMPARE (which you can omit if the default behavior is acceptable) and OPTION EXPLICIT (which you ignore only at your increased peril.)

learn.microsoft.com

Option Compare statement (VBA)

Office VBA reference topic
learn.microsoft.com

OPTION EXPLICIT tells VBA to not be so forgiving with variable declarations. If you have something spelled incorrectly when compared against its declaration or definition, with OPTION EXPLICIT you will be notified of the attempted use of an undeclared variable - which is a typical error for new VBA users. Having an undeclared variable can be anywhere from a totally ignorable condition to a critical, potentially fatal error that is to be avoided.
 
Many thanks CJ London you are great! the sky is the limit you have really made my new present 2025.

Once again thank you

Regards

Ch
 
You must log in or register to reply here.

Similar threads

N
Solved How to remove this error "the execution this software stopped due to run time" error in MS Access VBA
Replies
6
Views
171
The_Doc_Man
The_Doc_Man
N
Solved I want to be able to send a few emails in access 2016 using gmail but am having challenges
Replies
7
Views
163
nector
N
N
Solved How to add an attachment in Gmail managed in MS Access VBA
Replies
7
Views
134
nector
N
B
.send - anyway to continue processing & not wait. Using CDO. schemas to send emails
Replies
19
Views
680
AngelSpeaks
A
K
How can I add this code to the storage location of my file before scanning and then convert it to a PDF file?
2
Replies
25
Views
626
The_Doc_Man
The_Doc_Man

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom