send Mail by outlook from excel sheet





Sub outlookmailxlsheet()

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
 
    Set rng = Nothing

    Set rng = Sheets("YourSheet").UsedRange

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

    On Error Resume Next
    With OutMail
        .To = "XX@gmail.com"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = RangetoHTML(rng)
        .Send   'or use .Display
    End With

    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

Comments

Post a Comment

Popular posts from this blog

Check folder exist or not in excel vba

Check if Folder Exists using Excel VBA 'In this Example I am checking if "C:\Temp" exits Sub sbCheckingIfAFolderExists() Dim FSO Dim sFolder As String sFolder = "C:\Temp" ' You can Specify Any Folder To Check It Set FSO = CreateObject("Scripting.FileSystemObject") If FSO.FolderExists(sFolder) Then MsgBox "Specified Folder Is Available", vbInformation, "Exists!" Else MsgBox folder &"Specified Folder Not Found", vbInformation, "Not Found!" End If End Sub ------------------------ Opening Folders using VBA Excel 'In this Example I am Opening a Folder ("C:\Temp") Sub sbOpeningAFolder() Dim FSO Dim sFolder As String sFolder = "C:\Temp" 'You can specify your Folder which you wants to Open Set FSO = CreateObject("Scripting.FileSystemObject") If Not FSO.FolderExists(sFolder) Then MsgBox "Specified Folder Not Found", vbInformation, ...
Read more

Excel to notepad

Sub TestNotePad()     '// The range to copy - written freehand so change as needed     Range("A1:B55").Copy         '// Start Notepad with focus     Shell "notepad.exe", vbNormalFocus         '// Send the standard CTRL+V. Pastes to the     '// active window (Notepad, hopefully)     SendKeys "^V"     '// Back to the top of the file     SendKeys "^{HOME}"     End Sub ------------------- cebu1014 Author Commented: 2013-05-22 I got it to work using your above routine as a guide. I removed some of the lines though and added  TRUE at end of sendkeys command in order to get it to work. Sub CopyToNotepad()              Range("A1").Select     Range(Selection, Selection.End(xlDown)).Select     Selection.Copy       Shell "Notepad C:\Users\mw1\my Documents\abc.csv", vbNor...
Read more

combine sheets into one book and all sheets into one sheet

combine sheets into one book and all sheets into one sheet Sub getdata_Fromallbooks() ' Path = ThisWorkbook.Path & "\st\" Filename = Dir(Path & "*.xls")   Do While Filename <> ""   Workbooks.Open Filename:=Path & Filename, ReadOnly:=True      For Each Sheet In ActiveWorkbook.Sheets      Sheet.Copy After:=ThisWorkbook.Sheets(1)   Next Sheet      Workbooks(Filename).Close      Filename = Dir()   Loop End Sub Sub Combine()     Dim J As Integer     On Error Resume Next     Sheets(1).Select     Worksheets.Add ' add a sheet in first place     Sheets(1).Name = "Combined"     ' copy headings     Sheets(2).Activate     Range("A1").EntireRow.Select     Selection.Copy Destination:=Sheets(1).Range("A1")     ' work through sheets     For J = 2 To Sheets.Count ' ...
Read more