Automatic sending email

**Andrew-R** · 08-15-2011, 06:31 AM

You can identify which workbook you're talking about by:

a. Refering to it by name, e.g. Workbooks("My workbook.xlsx").SendMail

b. Or by index number, e.g. Workbooks(1).SendMail

c. Or by assigning the workbook to a workbook object, e.g.

Dim wbkMyBook as Workbook

Set wbkMyWorkbook=Workbooks.Open (sFolderPath & sCurrentFile)

wbkMyWorkbook.SendMail Recipients:="Fred Bloggs"

d. By activating it before you use it and then using the Activeworkbook object

e. By running the macro code from within the workbook you want to use and using the ThisWorkbook object.

f. Probably lots of other ways that the good people here will be kind enough to suggest.

If you only want to send Sheet1 then I'd copy sheet 1 from the target workbook to a new workbook and assign that workbook to a workbook object.

Does that help?

**aman1234** · 08-15-2011, 07:21 AM

Andrew,
If I write the following code then it gives an error message that this workbook is already opened.

Set wbkMyWorkbook=Workbooks.Open (sFolderPath & sCurrentFile)

As we have opened all the workbooks using the code you sent me earlier so I am confused. Can you please send me the exact that solves my purpose.

Thanks a lot for your help .

**aman1234** · 08-15-2011, 07:32 AM

I am writing the following code but It doesn't include anything in the body and an empty email is being sent.


Sub Mail_Selection_Range_Outlook_Body(a As String)

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next
   Dim wbkMyBook As Workbook


    Set rng = Workbooks("C:\Documents and Settings\Desktop\A1").Worksheet(a).UsedRange
    
    On Error GoTo 0

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

    Set OutApp = New Outlook.Application
    Set OutMail = OutApp.CreateItem(olMailItem)

    On Error Resume Next
    With OutMail
      
               .Recipients.Add "Smith Morgan"
                
        .Subject = "Reminder"
        .HTMLBody = RangetoHTML(rng)
        .Send
    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)
    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"
    
    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
 
    
    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
 
    
    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=")
 
    
    TempWB.Close SaveChanges:=False
 
    
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function