Dobut in sending mail thru VBA

[gopdeep]

pls have a luk on below code

Private Sub CommandButton1_Click()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim rng As Range
    Dim str As String, str1 As String
    Dim in1 As String, in2 As String
    in1 = InputBox("Range1:")
    in2 = InputBox("Range2:")
    Set rng = Sheets("sheet1").Range(in1 & ":" & in2).SpecialCells(xlCellTypeVisible)
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    strbody = ActiveSheet.Range(in1 & ":" & in2).Select
    str = "<font face='Trebuchet MS' size=2 color=blue >" & "Hi All," & "<br><br>" & "Good Morning !!!" & "<br><br>" & "Please find today's allocation below:" & "<br><br>" & "</font>"
    str1 = "<font face='Trebuchet MS' size=2 color=blue >" & "Thanks," & "<br>" & "GopDeep" & "</font>"
    On Error Resume Next
        With OutMail
        .To = "gopdeep@aaa.com"
        .CC = "gopdeep1@aaa.com"
        .BCC = ""
        .Subject = "Sample" & Chr(32) & Range("H4") & " Mail it is"
        .HTMLBody = str & RangetoHTML(rng) & "<br><br>" & str1
        .Display
        .ReadReceiptRequested = True
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

above code is working fine, but in mail body table is not appearing properly.

that is last row of the table is not having line in it... i couldn't resolve it even after many try... pls me

 

[AlexAC]

This might work for you:

Private Sub CommandButton1_Click()

Dim OutApp As Object
Dim OutMail As Object
Dim rng As Range
Dim str As String, str1 As String
Dim in1 As String, in2 As String
in1 = InputBox("Range1:")
in2 = InputBox("Range2:")
Set rng = Sheets("sheet1").Range(in1 & ":" & in2).SpecialCells(xlCellTypeVisible)
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
strbody = ActiveSheet.Range(in1 & ":" & in2).Select
str = "" & "Hi All," & "" & "Good Morning !!!" & "" & "Please find today's allocation below:" & "" & ""
str1 = "" & "Thanks," & "" & "GopDeep" & ""
On Error Resume Next
With OutMail
.To = "gopdeep@aaa.com"
.CC = "gopdeep1@aaa.com"
.BCC = ""
.Subject = "Sample" & Chr(32) & Range("H4") & " Mail it is"
.Body = str & (rng) & "" & str1
.Display
.ReadReceiptRequested = True
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

 

[AlexAC]

If not follow this as an example:

NOTE: the below script won't work unless has "all the necessary". But yo can use it as an example. This is what i use at work.

Sub Avocent_E() 'AVOCENT Electronice
Dim olLook As Object 'Start MS Outlook
Dim olNewEmail As Object 'New email in Outlook
Dim strEmailSubject As String 'Contact email address
Set olLook = CreateObject("Outlook.Application")
Set olNewEmail = olLook.CreateItem(0)
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Sheets("PARTURI SUSPECTE INCOMING").Select
ActiveWorkbook.Save
Subject = ActiveCell.Offset(0, 1).Range("A1")

nameList = nameList & ";" & Sheets("Emails").Range("C5").Value 'Contacts range
EmailSendTo = nameList
With olNewEmail 'Attach template
.To = EmailSendTo
.CC = Sheets("Emails").Range("C6").Value
.Body = strEmailText
.Subject = strEmailSubject
'.attachments.Add ("S:\Email template\Information Templatev3.xls")
.Display

End With
End Sub

 

[gopdeep]

well it doesn't work...

example which you provided is to get the TO IDs from cells but i wants to get table from sheet which will be pasted in BODY of the mail.

my code is working as expected, but the problem is last row doesn't have line to enclose the table.

still if you need more details pls let me know the way to paste the screenshot in post, so that i can provide it.

 

[AlexAC]

Better send a screen shot if you can

 

[gopdeep]

how to insert image... is there any tags like [ code ] [ / code]

 

[AlexAC]

I don't know, but as i remember you have to be a higher user to post images.

 

[gopdeep]

then...

i'll try to explain the issue pls resolve it...

am copying one table from the excel sheet and pasting it into the body of mail. in this case - last row of the table is not having line at bottom, table is getting pasted properly except last row. because bottom line is missing at the end of run.

can you correct it................................

 

[gopdeep]

here you should note that last line in the sense just LINE... data and all getting copied & pasted properly... pblm is only with drawing a line at bottom...

 

[AlexAC]

Try to recheck your script RangeToHTML is not defined. I don't know how this woks for you.