VB help – in over my head (as usual)

R

rfinnegan

Board Regular
Joined
Mar 15, 2005
Messages
173
Office Version
  1. 365
Platform
  1. Windows
Hi All –

In a nutshell, I’m trying to open a file, run an Auto Open macro (shown below) that imports data, saves the file with a different name, and emails that file to several people, then closes Excel…All as a scheduled task.

Here’s what I’ve accomplished -
- I have a scheduled task that opens a file that has the Auto Open macro.
- The Auto Open macro opens and imports data from a second file and manipulates it properly.
- The Auto Open macro saves the file with a new name, closes the file, and sends an email via Gmail.

What I can’t accomplish is to have the newly created file attached to the email. Is it possible to do it through Gmail? Unfortunately, I can't do this through Outlook and our Exchange Server.

I’ve downloaded the sample and info from http://www.rondebruin.nl/cdo.htm, but still can’t get it to do what I want (you'll see most of the macro is based on his work).

When I try to add what I think is the part Ron Derubin’s code that attaches the file, I get an error.

If attaching a file isn’t possible, I would settle for a hyperlink.

Thanks in advance. And by the way, the macro is 99% other peoples creation. The 1% that doesn’t work is mine…


Sub Auto_Open()
'
' Auto_Open Macro
' Macro recorded 7/20/2011
'

'
Range("B3").Select
Workbooks.Open Filename:= _
"C:\Documents and Settings\me\My Documents\testopen.xls"
Range("B4:D20").Select
Selection.Copy
Windows("Daily.xls").Activate
Range("B4").Select
ActiveSheet.Paste
Range("E8").Select
Windows("testopen.xls").Activate
Range("K9").Select
ActiveWindow.Close
Range("E4").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"
Range("E4").Select
Selection.Copy
Range("E5:E20").Select
ActiveSheet.Paste
Range("G21").Select
ActiveWindow.SmallScroll Down:=-6
ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\me\My Documents\test" & _
Format(Now(), "mm_dd_yyyy hh mm AMPM"), FileFormat:=xlNormal, Password:="", _
WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

'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

Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

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") = "mygmailaddressishere@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypwishere"
.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") = 465
.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 = "me@mywork.com"
.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 = """Robert"" <me@gmail.com>"
.Subject = "Important message"
.TextBody = strbody
.Send
End With


Application.Quit
ThisWorkbook.Close SaveChanges:=True


End Sub
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Sort by date Sort by votes
Try something like this (not tested).

Code: 
Sub Auto_Open()
    '
    ' Auto_Open Macro
    ' Macro recorded 7/20/2011
    '
    [COLOR="Red"]Dim MyFile As String[/COLOR]

    Range("B3").Select
    Workbooks.Open Filename:= _
                   "C:\Documents and Settings\me\My Documents\testopen.xls"
    Range("B4:D20").Select
    Selection.Copy
    Windows("Daily.xls").Activate
    Range("B4").Select
    ActiveSheet.Paste
    Range("E8").Select
    Windows("testopen.xls").Activate
    Range("K9").Select
    ActiveWindow.Close
    Range("E4").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"
    Range("E4").Select
    Selection.Copy
    Range("E5:E20").Select
    ActiveSheet.Paste
    Range("G21").Select
    ActiveWindow.SmallScroll Down:=-6
    [COLOR="Red"]MyFile = "C:\Documents and Settings\me\My Documents\test" & _
             Format(Now(), "mm_dd_yyyy hh mm AMPM") & ".xls"[/COLOR]
    ActiveWorkbook.SaveAs Filename:=[COLOR="Red"]MyFile[/COLOR], FileFormat:=xlNormal, Password:="", _
                                    WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    [COLOR="Red"]Actveworkbook.Close False[/COLOR]
    '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"" "

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

    Dim iMsg   As Object
    Dim iConf  As Object
    Dim strbody As String
    Dim Flds   As Variant

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

    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") = "mygmailaddressishere@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypwishere"
        .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") = 465
        .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 = "me@mywork.com"
        .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 = """Robert"" "
        .Subject = "Important message"
        .TextBody = strbody
        [COLOR="Red"].AddAttachment MyFile[/COLOR]
        .Send
    End With


    Application.Quit
    ThisWorkbook.Close SaveChanges:=True


End Sub
 
Upvote 0
Thanks AlphaFrog.

Unfortunately it didn't work. The macro runs as before, but now there isn't even an email.

Im starting to think the hyeprlink might be the best solution.
 
Upvote 0
One more try (i think you're getting close).

Code: 
Sub Auto_Open()
    '
    ' Auto_Open Macro
    ' Macro recorded 7/20/2011
    '
    Dim MyFile As String

    Range("B3").Select
    Workbooks.Open Filename:= _
                   "C:\Documents and Settings\me\My Documents\testopen.xls"
    Range("B4:D20").Select
    Selection.Copy
    Windows("Daily.xls").Activate
    Range("B4").Select
    ActiveSheet.Paste
    Range("E8").Select
    Windows("testopen.xls").Activate
    Range("K9").Select
    ActiveWindow.Close
    Range("E4").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"
    Range("E4").Select
    Selection.Copy
    Range("E5:E20").Select
    ActiveSheet.Paste
    Range("G21").Select
    ActiveWindow.SmallScroll Down:=-6
    MyFile = "C:\Documents and Settings\me\My Documents\test" & _
             Format(Now(), "mm_dd_yyyy hh mm AMPM") & ".xls"
    [COLOR="Red"]ActiveWorkbook.SaveCopyAs Filename:=MyFile[/COLOR]

    '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"" "

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

    Dim iMsg   As Object
    Dim iConf  As Object
    Dim strbody As String
    Dim Flds   As Variant

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

    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") = "mygmailaddressishere@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypwishere"
        .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") = 465
        .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 = "me@mywork.com"
        .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 = """Robert"" "
        .Subject = "Important message"
        .TextBody = strbody
        .AddAttachment MyFile
        .Send
    End With


    Application.Quit
    ThisWorkbook.Close SaveChanges:=True


End Sub
 
Upvote 0
There may be a problem with the previous code. It saves a copy of the modified "Daily" workbook so it can be attached to your email. The modified copy includes the Auto_Open macro which will automatically run when you open the copy. I doubt you want that.

The code below saves a copy of only the modified worksheet (no Auto_Open macro in the copy).

Code: 
Sub Auto_Open()
    '
    ' Auto_Open Macro
    ' Macro recorded 7/20/2011
    '
    Dim MyFile As String, wb As Workbook, ws1 As Worksheet
    
    Set ws1 = ThisWorkbook.Sheets(1)
    
    Application.ScreenUpdating = False

    Set wb = Workbooks.Open(Filename:= _
        "C:\Documents and Settings\me\My Documents\testopen.xls")
    wb.ActiveSheet.Range("B4:D20").Copy Destination:=ws1.Range("B4")
    wb.Close False
    ws1.Range("E4").FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"
    ws1.Range("E4").Copy Destination:=Range("E5:E20")
    ws1.Copy    'Copy Sheet1 to a new workbook
    MyFile = "C:\Documents and Settings\me\My Documents\test" & _
             Format(Now(), "mm_dd_yyyy hh mm AMPM") & ".xls"
    ActiveWorkbook.SaveAs Filename:=MyFile
    ActiveWorkbook.Close False
    '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"" "

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

    Dim iMsg   As Object
    Dim iConf  As Object
    Dim strbody As String
    Dim Flds   As Variant

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

    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") = "mygmailaddressishere@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypwishere"
        .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") = 465
        .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 = "me@mywork.com"
        .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 = """Robert"" "
        .Subject = "Important message"
        .TextBody = strbody
        .AddAttachment MyFile
        .Send
    End With

    Application.ScreenUpdating = True
    Application.Quit
    ThisWorkbook.Close SaveChanges:=True


End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question Question
CDO_Mail_Small_Text Run time error
Replies
0
Views
151
Louis chiron
L
S
  • Question Question
VBA to email multiple ranges on a sheet.
Replies
0
Views
522
shophoney
S
F
  • Solved
CDO Emails
Replies
1
Views
2K
Fire_Chief
F
S
  • Question Question
Email with VBA without outlook
Replies
4
Views
2K
Shloime
S
T
  • Question Question
vba to send calendar appointments rather then emails
Replies
1
Views
690
Tej92
T

Forum statistics

Threads
1,224,597
Messages
6,179,808
Members
452,944
Latest member
2558216095

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top