• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

.attachments.add (attach workbook) to email

bvanscoy678

Member
Hi,

I'm running a macro that opens each workbook in a folder, collects the email from a cell, attaches the workbook and emails with a gmail account. I have stepped through the code and it looks like all my variables are correct, but I get an error on adding the attachment. I've looked through Ron de Bruin's site with no luck.

Thanks for any help, Brent

Code:
 .Attachments.Add wb

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
 
    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"
        .Attachments.Add wb
        .TextBody = strbody
        .Send
    End With
 
End Sub
 
I think you need to change the line in question to:
Code:
.Attachments.Add ActiveWorkbook.FullName
Note that this does require the ActiveWorkbook to have been saved.
 
It's a property of a workbook. Returns a string detailing the full path for your book, something like:
"C:\My Documents\My workbook.xls"
 
Hi,

I combined my macro into one sub routine, so I could utilize MyFile (not sure if that was good)

I add:

wb.save (not sure I put it in the right place)
.Attachments.Add ActiveWorkbook.FullName

Still no luck. Would this be better using outlook?

Thanks



Code:
Sub Test()
 
'''''''Original Post from EE search
    Dim myDir As String
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    Dim Email 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
             
 
   
    wb.Save
     
   
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    Set wb = ActiveWorkbook
   
    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") = "XXXXXXX"
        .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
           
     
        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"
 
    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
 
Possibly. I'll admit I don't have any experience trying to use the gmail server to send the mail. :(
 
Okay. I think I'll switch to Outlook to make it easier on myself. Thank you for the help. I'll make another run at it.

Thanks
 
Back
Top