Posts by brian1978

    Thx. It helped me somewhat. How would this code look like if the e-mail adresses were in column AD and the data in the mail were from the columns B, D, E, F, I, J, K, M, and N. Data from column Q, R, and S should also be included if value > 0.

    Sub Send_Row_Or_Rows_2()

    'For Tips see:
    'Don't forget to copy the function RangetoHTML in the module.
    'Working in Excel 2000-2016

    Dim OutApp As Object

    Dim OutMail As Object

    Dim rng As Range

    Dim Ash As Worksheet

    Dim Cws As Worksheet

    Dim Rcount As Long

    Dim Rnum As Long

    Dim FilterRange As Range

    Dim FieldNum As Integer

    On Error GoTo cleanup

    Set OutApp = CreateObject("Outlook.Application")

    With Application

    .EnableEvents = False

    .ScreenUpdating = False

    End With

    'Set filter sheet, you can also use Sheets("MySheet")

    Set Ash = ActiveSheet

    'Set filter range and filter column (column with e-mail addresses)

    Set FilterRange = Ash.Range("A1:H" & Ash.Rows.Count)

    FieldNum = 2 'Filter column = B because the filter range start in column A

    'Add a worksheet for the unique list and copy the unique list in A1

    Set Cws = Worksheets.Add

    FilterRange.Columns(FieldNum).AdvancedFilter _

    Action:=xlFilterCopy, _

    CopyToRange:=Cws.Range("A1"), _

    CriteriaRange:="", Unique:=True

    'Count of the unique values + the header cell

    Rcount = Application.WorksheetFunction.CountA(Cws.Columns(1))

    'If there are unique values start the loop

    If Rcount >= 2 Then

    For Rnum = 2 To Rcount

    'Filter the FilterRange on the FieldNum column

    FilterRange.AutoFilter Field:=FieldNum, _

    Criteria1:=Cws.Cells(Rnum, 1).Value

    'If the unique value is a mail addres create a mail

    If Cws.Cells(Rnum, 1).Value Like "?*@?*.?*" Then

    With Ash.AutoFilter.Range

    On Error Resume Next

    Set rng = .SpecialCells(xlCellTypeVisible)

    On Error GoTo 0

    End With

    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next

    With OutMail

    .to = Cws.Cells(Rnum, 1).Value

    .Subject = "Test mail"

    .HTMLBody = RangetoHTML(rng)

    .Display 'Or use Send

    End With

    On Error GoTo 0

    Set OutMail = Nothing

    End If

    'Close AutoFilter

    Ash.AutoFilterMode = False

    Next Rnum

    End If


    Set OutApp = Nothing

    Application.DisplayAlerts = False


    Application.DisplayAlerts = True

    With Application

    .EnableEvents = True

    .ScreenUpdating = True

    End With

    End Sub

    No image or attachtment, just body text (the result). The first mails body would be "Result: 1 vbnewline Result: 2". Second mail would be "Result 2"

    This is just an example, but I will develop it further my self if someone kan help me with the above part

    I'm trying to find a code that can send a mail from Excel, but where there theres is only 1 mail per recipient - even if their e-mail adress are severel times in the rows data. An exampel could look like this:

    E-mail Result

    [email protected] 1

    [email protected] 2

    [email protected] 2

    [email protected] 1

    [email protected] 3

    So the recipient with [email protected] adress should only recieve 1 mail with result 1 and 2 in the mails body text.

    The recipient with [email protected] adress should recieve 1 mail with result 2 in the mails body text. etc...

    Hope you can help me