mail data from listbox

Question

Hello,

dear developer, kindly please i need your support it this issue as i have exported data to listbox, is that any way to mail these data via outlook mail,

you have to take a look to the whole workbook, you can call the listbox from sheet that called "Interface",  this listbox retrieve the data as per auto filter based on 3 criteria, 3 combobox. and export the data from 2 different worksheets.

if sending this retrieved listbox data via outlook is available, need to send the mail to: ("Data!$K$3") & CC: ("Data!$K$4"), and what about of the subject; i have two buttons to retrieve the data "Daily" and "Monthly", in i hit "Daily" button need the subject to be "Daily Report", but if hit "Monthly" the subject will be "Monthly Report", 

and the body, before the exported list need this line:

Dear ("Data!$K$2") 

you have to take a look to your "Subject" 

"List"

     Mail listbox

Gratefully,

Answer 1

Rather than code this for you I will tell you how to code it.

At the very top of the VBA code in the Userform module (before any Subs) dimension a variable like the following:

Dim MthlyDailyIdentifier As String

The variable will then be available to all of the Subs in the Userform module. (Do NOT Dim this variable in any of the subs.)

Insert the following line as the first line of code after the Dim statements in Private Sub Daily_Click()

MthlyDailyIdentifier = "Daily"

Insert the following line as the first line of code after the Dim statements in Private Sub Monthly_Click()

MthlyDailyIdentifier = "Monthly"

You can now use an If statement with the following code to set the range for either the Daily or Monthly report..

    If MthlyDailyIdentifier = "Daily" Then

        Set rng = Sheets("Data").Range("K6:U32").SpecialCells(xlCellTypeVisible)

    Else

     'set rng to the alternative range here for Monthly Identifier.

     'I have already given you code to find the last non blank cell in column U

End If

Answer 2

Hello Ossie,

i'm already solved the mailing issue via the above code, but this code use a fixed range of data to send it in mail body.

to get the whole image, this table that i need to send is dynamic, because it's exported from a listbox data, these listbox controlled by two button to retrieve the range

when hit "Monthly" the range restricted, when hit "Daily" the range expanded as per the filled source.

these range is copied it to the range that i need to send via Outlook, 

when use daily the filled range is ("K11:U33"), this range isn't fixed may be end till U32, U30 as per the retrieved source

but when click "Monthly" the table range restricted to be ("K11:S12")

  what i need is to adjust this line at the above mailing code 

 Set rng = Sheets("Data").Range("K11:U33").SpecialCells(xlCellTypeVisible)

need to set cell ("U33") to be the last indexed cell at the table, to be able to send filled cell only, instead of sending the whole table that may have a blank cell which isn't necessary to send 

i have uploaded the workbook.zip you cal call the listbox from "Interface" sheet, and the desired table located at "Data" sheet,

The workbook

if this issue need to start a new thread, please let me know that :)

thanks a lot,

Answer 3

I am not sure if you have resolved the problem with the code you posted or if you are asking another question.

Your comment: *"note: last indexed cell must have a data as may have a formula that refer to Blank".*Did you resolve that with filtering out the blanks? If not then the following example finds the last non blank cell in a column. See the comments at the end of the code for explanation.

Sub LastNonBlankCell()

    Dim rngColU As Range

    Dim rngLastNonBlank As Range

    With Worksheets("Sheet1")

        'Assign used range of column U to a range variable.

        'rngColU will include cells with formulas that return blanks.

        Set rngColU = .Range(.Cells(1, "U"), .Cells(.Rows.Count, "U").End(xlUp))

    End With

    'Find the last non blank cell in rngColU

    With rngColU

        Set rngLastNonBlank = .Find(What:="*", After:=.Cells(1, 1), _

                            LookIn:=xlValues, _

                            LookAt:=xlWhole, _

                            SearchOrder:=xlByRows, _

                            SearchDirection:=xlPrevious, _

                            MatchCase:=False)

    End With

    If Not rngLastNonBlank Is Nothing Then

        MsgBox "Last non blank cell in column U is " & rngLastNonBlank.Address(0, 0)

    End If

End Sub

'Find asterisk is a wild card so finds anything.

'After:=.Cells(1, 1) is after the first cell in rngColU

'LookIn:=xlValues  only finds cells with a value (blank returned by a formula _

 is not a value so it is by-passed)

'SearchDirection:=xlPrevious loops around and looks from bottom of range upwards

'so next cell that is looked at after .Cells(1, 1) is the last cell of the range

'and it moves upwards after that.

Answer 4

Hi Ossie,

at first i'm really get your point about WinZip in my uploaded file, i'll will usually. 

for the above thread i used the llistbox pupped up data as a source to mail it to outlook e-mail body with some support also from rondebruin mailing codes, 

i used a fixed range to send: 

 Set rng = Sheets("Data").Range("K6:U32").SpecialCells(xlCellTypeVisible)

but i need this range to be dynamic based on a specific cell: Worksheets("DATA").Range("K5"). "this cell that i use as the mail title,    

if ("K5") = "Daily report" need the range will be ("K6: till last indexed cell in column U), 

note: last indexed cell must have a data as may have a formula that refer to Blank

if ("K5") = "Monthly Report" need the range be (K6:S11)

the whole code that i use for mailing the range 

Private Sub Mail_Data_Click()

'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm

'Don't forget to copy the function RangetoHTML in the module.

'Working in Excel 2000-2013

    Dim rng As Range

    Dim OutApp As Object

    Dim OutMail As Object

    Set rng = Nothing

    On Error Resume Next

    'Only the visible cells in the selection

    'Set rng = Selection.SpecialCells(xlCellTypeVisible)

    'You can also use a fixed range if you want

    Set rng = Sheets("Data").Range("K6:U32").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 = ThisWorkbook.Worksheets("DATA").Range("K3")

        .CC = ThisWorkbook.Worksheets("DATA").Range("K4")

        .BCC = ""

        .Subject = ThisWorkbook.Worksheets("DATA").Range("K5")

        .HTMLBody = RangetoHTML(rng)

        .display   'or use .Display

    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-2013

    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

thanks a lot,

Answer 5

The following is a simple example to email via Outlook from an Excel workbook. You should be able to adapt the code to use your listbox data.

You should think about accepting my previous advice to use WinZip because it possibly restricts the number of people on the forum who will provide you with assistance.

**Suggestion:**Keep the .Display line in lieu of .Send until you have finished development and then comment out .Display and uncomment .Send. Reason is that .Display that opens the email in Outlook for you to peruse before clicking Send button and instead of sending you can simply delete it without sending.

Sub SendEmail()

    Dim OutApp As Object

    Dim OutMail As Object

    Dim ws As Worksheet

    Set OutApp = CreateObject("Outlook.Application")

    Set OutMail = OutApp.CreateItem(0)

    With OutMail

        'Following line where email address is in cell A1

        .To = ThisWorkbook.Worksheets("Sheet1").Range("A1") 'Where email address is in cell A1

        '.To = "******@serviceprovidor.com"  'Alternative

        .CC = ""    'Do not need to include this line if no CC

        .BCC = ""   'Do not need to include this line if no BCC

        .Subject = "This is the Subject line"

        'Can use variables to assign the string to the Body.

        .Body = "Please peruse the attachent and reply with your comments."

        'Attachments are optional as per the 2 options commented out

        '.Attachments.Add ThisWorkbook.Path & "" & "Sample Attachment.xlsx"

        'Following line is alternative to attach ThisWorkbook that contains the VBA code

        '.Attachments.Add ThisWorkbook.FullName

        .Display    'To display and user clicks send. (Comment out if .Send uncommented)

        '.Send       'To automatically send. (Comment out .Display if this line uncommented)

    End With

    Set OutMail = Nothing

    Set OutApp = Nothing

    With Application

        .EnableEvents = True

        .ScreenUpdating = True

    End With

End Sub