Add Attachment to Email - CDO - GMAIL - Each file in Folder

Hi,

I have cobbled together a few pieces of code and modified to meet my needs. Simply put, I am looping through a folder and emailing each Excel workbook, which the email address comes from the active workbook. I have everything working, except I can't figure how to add the workbook to the email.

Thanks, Brent

I tried (partial code)

With iMsg
        Set .Configuration = iConf
        .To = Email
        .CC = ""
        .BCC = ""
        ' Note: The reply address is not working if you use this Gmail example
        ' It will use your Gmail address automatic. But you can add this line
        ' to change the reply address  .ReplyTo = "Reply@something.nl"
        .From = """Brent"" <bvanscoy678@gmail.com>"
        .Subject = "Important message"
        .Attachments.Add MyWorkbook
        .TextBody = strbody
        .Send
    End With

Open in new window


Full Code

Sub Test()

'''''''Original Post from EE search

    Dim myDir As String
 
    myDir = "C:\Documents and Settings\bvanscoy\Desktop\Split"
    MyFile = Dir(myDir & "\*.xl*")
 
    Do While MyFile <> ""
        Workbooks.Open myDir & "\" & MyFile
              
            Call CDO_Mail_Small_Text_2
      
        ActiveWorkbook.Close True
        
        
        MyFile = Dir
    Loop
    
    End Sub
    
''''''''''''' Original File from http://www.rondebruin.nl/win/s1/cdo.htm
''''''''''''' Support paid to Ron's site

Sub CDO_Mail_Small_Text_2()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    Dim Email As String

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    
    Email = Worksheets(1).Cells(3, 4).Value

    iConf.Load -1    ' CDO Source Defaults
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "bvanscoy678@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "XXXXXXXXXX"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With

    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

    With iMsg
        Set .Configuration = iConf
        .To = Email
        .CC = ""
        .BCC = ""
        ' Note: The reply address is not working if you use this Gmail example
        ' It will use your Gmail address automatic. But you can add this line
        ' to change the reply address  .ReplyTo = "Reply@something.nl"
        .From = """Brent"" <bvanscoy678@gmail.com>"
        .Subject = "Important message"
        .Attachments.Add MyWorkbook
        .TextBody = strbody
        .Send
    End With
End Sub

Open in new window

bvanscoy678Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Ken ButtersCommented:
Instead of

.Attachments .Add MyWorkbook

seems like you should be using

.Attachments .Add ActiveWorkbook
0
bvanscoy678Author Commented:
Hi,

I tired adding your syntax, but still get an error. I'll keep at it.

Thanks,
0
Ken ButtersCommented:
what is the error?
0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

bvanscoy678Author Commented:
I changed the code a bit, but it is giving me a RunTime Error 13 - Type Mismatch

Here is my full new code:


Sub Test()

'''''''Original Post from EE search
Dim myDir As String
 
    myDir = "C:\Documents and Settings\bvanscoy\Desktop\Split"
    MyFile = Dir(myDir & "\*.xl*")
 
    Do While MyFile <> ""
        Workbooks.Open myDir & "\" & MyFile
              
            Call CDO_Mail_Small_Text_2
      
        ActiveWorkbook.Close True
        
        
        MyFile = Dir
    Loop
    
    End Sub
    
''''''''''''' Original File from http://www.rondebruin.nl/win/s1/cdo.htm
''''''''''''' Support paid to Ron's site
'If you have a GMail account then you can try this example to use the GMail smtp server
'The example will send a small text message
'You must change four code lines before you can test the code

'.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Full GMail mail address"
'.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "GMail password"

'Use your own mail address to test the code in this line
'.To = "Mail address receiver"

'Change YourName to the From name you want to use
'.From = """YourName"" <Reply@something.nl>"

'If you get this error : The transport failed to connect to the server
'then try to change the SMTP port from 25 to 465

Sub CDO_Mail_Small_Text_2()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    Dim Email As String
       
    Dim wb As Workbook
    

      
     
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    Set wb = ActiveWorkbook
    
    wb.Save
    
    Email = Worksheets(1).Cells(3, 4).Value

    iConf.Load -1    ' CDO Source Defaults
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "bvanscoy678@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "XXXXX"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With

    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

    With iMsg
        Set .Configuration = iConf
        .To = Email
        .CC = ""
        .BCC = ""
        ' Note: The reply address is not working if you use this Gmail example
        ' It will use your Gmail address automatic. But you can add this line
        ' to change the reply address  .ReplyTo = "Reply@something.nl"
        .From = """Brent"" <bvanscoy678@gmail.com>"
        .Subject = "Important message"
        .Attachments.Add ActiveWorkbook.FullName
        .TextBody = strbody
        .Send
    End With

End Sub

Open in new window

0
Ken ButtersCommented:
Think I found the format that works...

change from this :

.Attachments.Add ActiveWorkbook.FullName

to this :

.AddAttachment ThisWorkbook.FullName

Also have to change your workbook to R/O first

Like this:

   ThisWorkbook.ChangeFileAccess xlReadOnly
   
    With iMsg
        Set .Configuration = iConf
        .To = Email
        .CC = ""
        .BCC = ""
        ' Note: The reply address is not working if you use this Gmail example
        ' It will use your Gmail address automatic. But you can add this line
        ' to change the reply address  .ReplyTo = "Reply@something.nl"
        .From = """Brent"" <bvanscoy678@gmail.com>"
        .Subject = "Important message"
       
        .AddAttachment ThisWorkbook.FullName
       
        .TextBody = strbody
        .Send
    End With

    ThisWorkbook.ChangeFileAccess xlReadWrite
0
bvanscoy678Author Commented:
Okay. I just left work, it will take me a little bit of time to get home and give it a run.

I'll check back. Thanks.
0
bvanscoy678Author Commented:
Hi,

I think I have turned myself around with ThisWorkbook and ActiveWorkbook. I am getting an error with the first readonly

Which file am I wanting to make read only? The workbook with my code or each workbook as I open them?

I am  a bit confused. Sorry, Brent

Sub Test()

'''''''Original Post from EE search
Dim myDir As String
 
    myDir = "C:\Documents and Settings\bvanscoy\Desktop\Split"
    MyFile = Dir(myDir & "\*.xl*")
 
    Do While MyFile <> ""
        Workbooks.Open myDir & "\" & MyFile
              
            Call CDO_Mail_Small_Text_2
      
        ActiveWorkbook.Close True
        
        
        MyFile = Dir
    Loop
    
    End Sub
    
''''''''''''' Original File from http://www.rondebruin.nl/win/s1/cdo.htm
''''''''''''' Support paid to Ron's site
'If you have a GMail account then you can try this example to use the GMail smtp server
'The example will send a small text message
'You must change four code lines before you can test the code

'.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Full GMail mail address"
'.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "GMail password"

'Use your own mail address to test the code in this line
'.To = "Mail address receiver"

'Change YourName to the From name you want to use
'.From = """YourName"" <Reply@something.nl>"

'If you get this error : The transport failed to connect to the server
'then try to change the SMTP port from 25 to 465

Sub CDO_Mail_Small_Text_2()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    Dim Email As String
       
    Dim wb As Workbook
    

      
     
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    Set wb = ActiveWorkbook
    
  
    
    wb.Save
    
    Email = Worksheets(1).Cells(3, 4).Value

    iConf.Load -1    ' CDO Source Defaults
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "bvanscoy678@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "XXXXXX"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With

    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

[b]    ThisWorkbook.ChangeFileAccess xlReadOnly[/b]
    
    With iMsg
        Set .Configuration = iConf
        .To = Email
        .CC = ""
        .BCC = ""
        ' Note: The reply address is not working if you use this Gmail example
        ' It will use your Gmail address automatic. But you can add this line
        ' to change the reply address  .ReplyTo = "Reply@something.nl"
        .From = """Brent"" <bvanscoy678@gmail.com>"
        .Subject = "Important message"
        
        .AddAttachment ThisWorkbook.FullName
        
        .TextBody = strbody
        .Send
    End With

    ThisWorkbook.ChangeFileAccess xlReadWrite
End Sub

Open in new window

0
Ken ButtersCommented:
Sorry.... I didn't think about that.  Thisworkbook would be the one with the code in it.
I try to stay away from activeb

Open in new window

ook, because that causes me issues if I open another book while vba code is running.   You could just omit the r/o stuff since you are not sending thisbook.  I prefer to create an object for the workbook, like 'wb' and then use just that reference.

try this.. I think it will make it clearer which workbook we are using.

I am passing the workbook object from your loop at the top, down into the routine that sends it.

That way you don't have to worry about which book is active.  As a matter of fact, that way it doesn't actually have to be the active book at all which is probably safer anyway.

Sub Test()

'''''''Original Post from EE search
Dim myDir As String
Dim wb As Workbook

    myDir = "C:\Documents and Settings\bvanscoy\Desktop\Split"
    MyFile = Dir(myDir & "\*.xl*")
 
    Do While MyFile <> ""
        
        Workbooks.Open myDir & "\" & MyFile
              
            CDO_Mail_Small_Text_2 Workbooks(myDir & "\" & MyFile)
      
        ActiveWorkbook.Close True
        
        
        MyFile = Dir
    Loop
    
    End Sub
    
''''''''''''' Original File from http://www.rondebruin.nl/win/s1/cdo.htm
''''''''''''' Support paid to Ron's site
'If you have a GMail account then you can try this example to use the GMail smtp server
'The example will send a small text message
'You must change four code lines before you can test the code

'.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Full GMail mail address"
'.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "GMail password"

'Use your own mail address to test the code in this line
'.To = "Mail address receiver"

'Change YourName to the From name you want to use
'.From = """YourName"" <Reply@something.nl>"

'If you get this error : The transport failed to connect to the server
'then try to change the SMTP port from 25 to 465

Sub CDO_Mail_Small_Text_2(wb As Workbook)
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    Dim Email As String
       
     
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    
    Email = Worksheets(1).Cells(3, 4).Value

    iConf.Load -1    ' CDO Source Defaults
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "bvanscoy678@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "XXXXXX"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With

    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

    
    With iMsg
        Set .Configuration = iConf
        .To = Email
        .CC = ""
        .BCC = ""
        ' Note: The reply address is not working if you use this Gmail example
        ' It will use your Gmail address automatic. But you can add this line
        ' to change the reply address  .ReplyTo = "Reply@something.nl"
        .From = """Brent"" <bvanscoy678@gmail.com>"
        .Subject = "Important message"
        
        .AddAttachment wb.FullName
        
        .TextBody = strbody
        .Send
    End With

End Sub

Open in new window

0
bvanscoy678Author Commented:
Sorry for the delay, my remote desktop at  work had a hard time connecting. I get  what you are doing, by passing the object between the two routines. But, I don't see where I set the wb variable? I commented out the error (I just set it to call CDO_Mail_Small_Text_2) and the variable is empty as I step through the code. The one thing that I have to read up on is how you are calling the code without Call .  Plus, I'll have to look up  the Workbooks(myDir & "\" & MyFile) at the end of calling the bottom routine.

I placed the code, but I got an error on the:

CDO_Mail_Small_Text_2 Workbooks(myDir & "\" & MyFile)

It is a runtime error 9. Subscript out of range.


Sorry to be a pain, but I really do enjoy trying to learn what the code is doing. Thanks for the help. Brent
0
Ken ButtersCommented:
No problem... that is what I get for trying to send code updates from my phone. :)

Here is another update... the main change is that when calling the subroutine, I should have used

CDO_Mail_Small_Text_2 Workbooks(MyFile)

instead of

CDO_Mail_Small_Text_2 Workbooks(myDir & "\" & MyFile)

workbooks is a collection, and it is indexed by the name of the workbook, not by the path.  That is why the error.

as far as calling a subroutine without the "call"... that one is fairly straighforward.

if you don't use parenthesis to enclose the parameters, then you can omit "Call". If you do use parenthesis, then ou do need the call.

so these to things are equivalent

Call CDO_Mail_Small_Text_2(Workbooks(MyFile))
           
CDO_Mail_Small_Text_2 Workbooks(MyFile)


So the way that the wb variable is initialized, is because in the called routine it is the parameter being passed in.

I tested the code here, and it seemed to work ok for me... up to the point of the 'Send'  it has some kind of SMTP error.

I guess your original question was around the attachment, which we got working... so I"m not sure if you will experience the SMTP error or not.

I was also having to fiddle with the R/O setting... and it might have something to do with the fact that my "Send" was not working.... but at least you have the format to play with as necessary.

Sub Test()

'''''''Original Post from EE search
Dim myDir As String
Dim wb As Workbook

    ' myDir = "C:\Documents and Settings\" & Environ("UserName") & "\Documents"
    myDir = "C:\Documents and Settings\bvanscoy\Desktop\Split"
    MyFile = Dir(myDir & "\*.xl*")
 
    Do While MyFile <> ""
        
        Workbooks.Open myDir & "\" & MyFile
              
            CDO_Mail_Small_Text_2 Workbooks(MyFile)
      
        ActiveWorkbook.Close True
        
        
        MyFile = Dir
    Loop
    
    End Sub
    
''''''''''''' Original File from http://www.rondebruin.nl/win/s1/cdo.htm
''''''''''''' Support paid to Ron's site
'If you have a GMail account then you can try this example to use the GMail smtp server
'The example will send a small text message
'You must change four code lines before you can test the code

'.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Full GMail mail address"
'.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "GMail password"

'Use your own mail address to test the code in this line
'.To = "Mail address receiver"

'Change YourName to the From name you want to use
'.From = """YourName"" <Reply@something.nl>"

'If you get this error : The transport failed to connect to the server
'then try to change the SMTP port from 25 to 465

Sub CDO_Mail_Small_Text_2(wb As Workbook)
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    Dim Email As String
       
     
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    
    Email = Worksheets(1).Cells(3, 4).Value

    iConf.Load -1    ' CDO Source Defaults
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "bvanscoy678@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "XXXXXX"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With

    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"
    
    wb.ChangeFileAccess xlReadOnly
    
    With iMsg
        Set .Configuration = iConf
        .To = Email
        .CC = ""
        .BCC = ""
        ' Note: The reply address is not working if you use this Gmail example
        ' It will use your Gmail address automatic. But you can add this line
        ' to change the reply address  .ReplyTo = "Reply@something.nl"
        .From = """Brent"" <bvanscoy678@gmail.com>"
        .Subject = "Important message"
        
        .AddAttachment wb.FullName
        
        .TextBody = strbody
        .Send
    End With

    wb.ChangeFileAccess xlReadWrite

End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
bvanscoy678Author Commented:
Great explanation. Thank you. I think the reason it would not send is because I replaced my password with XXXXXX, so it can't send it. It works perfect after one change.  I didn't get an error, but after it executes the 2nd  wb.ChangeFileAccess xlReadWrite it gives me a message on the workbook "is in use" and I need to choose Notify or Cancel. I commented out the 2nd R/O and it works perfect!

Thank you for taking the time with all the explanations and sticking with the thread. I greatly appreciate the learning experience!

Brent
0
bvanscoy678Author Commented:
Again, thanks for all the details of the code! Brent
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.