Sending as email a recently created workbook

Question

The following code creates a new file, which I need to attach to a email (outlook) after running.

Sub SaveAsNewFile()
'
' SaveAsNewFile Macro
'

Dim wkbWorkbook As Workbook                        'New Code
Dim wkbNewWorkbook As Workbook                     'New Code

Sheets("LMAIN_2").Select
    Columns("A:A").Select
    Workbooks.Add

    For Each wkbWorkbook In Workbooks              'New Code
      If Left(wkbWorkbook.Name, 4) = "Book" Then   'New Code
    Set wkbNewWorkbook = wkbWorkbook           'New Code
    Exit For                                   'New Code
      End If                                       'New Code
    Next wkbWorkbook                               'New Code


    Windows.CompareSideBySideWith "MAS_AutosendVer5.xlsm"
    Windows("MAS_AutosendVer5.xlsm").Activate
    Cells.Select
    With ActiveWindow
        .Width = 975
        .Height = 282.75
    End With
    Sheets("LMAIN_2").Select
    Columns("A:C").Select
    Selection.Copy
    wkbNewWorkbook.Activate                        'Replaced Code
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Cells.Select
    Cells.EntireColumn.AutoFit
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "LMAIN"
    Cells.Select
    Windows("MAS_AutosendVer5.xlsm").Activate
    Sheets("WLND_2").Select
    Columns("A:C").Select
    Application.CutCopyMode = False
    Selection.Copy
    wkbNewWorkbook.Activate                        'Replaced Code
    Sheets("Sheet2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Cells.Select
    Cells.EntireColumn.AutoFit
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "WLND"
    Cells.Select
    Windows("MAS_AutosendVer5.xlsm").Activate
    Sheets("IL1AGL_2").Select
    Columns("A:C").Select
    Application.CutCopyMode = False
    Selection.Copy
    wkbNewWorkbook.Activate                        'Replaced Code
    Sheets("Sheet3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Cells.Select
    Cells.EntireColumn.AutoFit
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "IL1AGL"
    Cells.Select
    Windows("MAS_AutosendVer5.xlsm").Activate
    Sheets("SANROS_2").Select
    Columns("A:C").Select
    Application.CutCopyMode = False
    Selection.Copy
    wkbNewWorkbook.Activate                        'Replaced Code
    Sheets.Add After:=Sheets(Sheets.Count)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("B15").Select
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "SANROS"
    Cells.Select
    Windows("MAS_AutosendVer5.xlsm").Activate
    Sheets("CA1AGL_2").Select
    Columns("A:C").Select
    Application.CutCopyMode = False
    Selection.Copy
    wkbNewWorkbook.Activate                        'Replaced Code
    Sheets.Add After:=Sheets(Sheets.Count)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Cells.Select
    Cells.EntireColumn.AutoFit
    Sheets("Sheet5").Select
    Sheets("Sheet5").Name = "CA1AGL"
    Cells.Select
    Windows("MAS_AutosendVer5.xlsm").Activate
    Sheets("FLDA_2").Select
    Columns("A:C").Select
    Application.CutCopyMode = False
    Selection.Copy
    wkbNewWorkbook.Activate                        'Replaced Code
    Sheets.Add After:=Sheets(Sheets.Count)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Cells.Select
    Cells.EntireColumn.AutoFit
    Sheets("Sheet6").Select
    Sheets("Sheet6").Name = "FLDA"
    Cells.Select
End Sub

            

Answer 1

You'll find MANY options here:

http://www.rondebruin.nl/sendmail.htm

Simply run the email-code after you run your current code.  For instance, just before your 'End Sub', enter the name of the Sub of your email.  Something like this:

    Cells.Select

Sub RunEmail()

End Sub

---

Ryan Shuell

Answer 2

It Doesnt work, if I put the code after Cells.Select

It gives me a Compile error, Expected End sub

Answer 3

i used rondebruin's website for outlook's code.  it works just fine.

Answer 4

use rondebruin's macro.

Create a new module (for example "Sub Sendemail") and paste it.

Put the modeule somewhere to execute it.  If you have trouble with the current macro.  I strongly recommend you to start a new xls file and use ron's macro to test it.  You will explore further.

Answer 5

Yes I know exactly how to use that code, that is the one I am using, but my question is how do i make it work, on a workbook that has just been created by another macro. Because the email macro will work fine on a saved workbook, but who do I redirect that code for a new workbook.

Answer 6

create a macro that opens the workbook of choice.  In the chain of execution, put the sendemail() macro.  That should work.

I have a macro that extract a specify info / table from a txt file and then sends it to a group of people.

Answer 7

this is ron's code with my comments

Sub Mail_Selection_Range_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2010

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
   
  
    Dim Emailto As String
    Dim ccEmailto As String
    Emailto = Workbooks("WBNAME.xls").Sheets("SHEETNAME").Range("B1") 'this is the path for the book check the line With OutMail and below
    ccEmailto = Workbooks("WBNAME.xls").Sheets("SHEETNAME").Range("B2") 'this is the path
   
   
    Set rng = Nothing
    On Error Resume Next
    'Only the visible cells in the selection
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    'You can also use a range if you want
    'Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        '.To = " CSharpNoob2011 <[e-mail]>"
        '.CC = "CSharpNoob2011 <[e-mail]>"
        .To = Emailto
        .CC = ccEmailto
       
        .Subject = "Atthached workbook" & " example"
        .HTMLBody = RangetoHTML(rng)
        .Display   'or use .Display and Application.Wait (Now + TimeValue("0:00:03")) and Application.SendKeys "%S"   to byass
        '.Send  <= doesn't work anymore
        '.Display
        'below auto sends the email
        'Application.Wait (Now + TimeValue("0:00:03"))  'this will bypass the .Send warning message.
        'Application.SendKeys "%S"                      'this is CTRL Send on outlook

    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'Close TempWB
    TempWB.Close savechanges:=False
 
    'Delete the htm file we used in this function
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Answer 8

To redirect the code to another workbok it is here.  Play with it and you will see :)  .  Please mark as Answered or helpful if it works or help you to make it work :D.

    Dim Emailto As String
    Dim ccEmailto As String
    Emailto = Workbooks("WBNAME.xls").Sheets("SHEETNAME").Range("B1") 'this is the path for the book check the line With OutMail and below
    ccEmailto = Workbooks("WBNAME.xls").Sheets("SHEETNAME").Range("B2") 'this is the path.        

Answer 9

I can't use wbname.xls as a constant, it changes all the time from book4 to book5 to book6 etc etc, that is why this is not working.

Answer 10

before i even go further.  Please mark as answered or helpful to previous questions that you've asked.  Especially to people who have helped you.

thank you.

Answer 11

@juanpablogallardo-

The code is getting a little crazy at this point.  When, EXACTLY, do you want to do?  Attach a workbook with a specific name, or attach a workbook that can be named anything.  Think to yourself, 'what is the logic'?  Post the 'logic' here.  Anything that has some kind of logic can be coded.  If there is not logic, you can't code up a solution.

---

Ryan Shuell