asked on

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

Ken Butters

Instead of

.Attachments .Add MyWorkbook

seems like you should be using

.Attachments .Add ActiveWorkbook

Brent

ASKER

Hi,

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

Thanks,

Ken Butters

what is the error?

Brent

ASKER

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

Ken Butters

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

Brent

ASKER

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.

Brent

ASKER

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

Ken Butters

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

Brent

ASKER

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

ASKER CERTIFIED SOLUTION

Ken Butters

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Brent

ASKER

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

Brent

ASKER

Again, thanks for all the details of the code! Brent