Monday, 2 December 2024

test how to send excel range

 Sub SendEmailsToAllUniqueIDs()
    Dim OutlookApp As Object
    Dim MailItem As Object
    Dim ws As Worksheet
    Dim emailDict As Object
    Dim cell As Range
    Dim lastRow As Long
    Dim email As String, data As String
    Dim consolidatedData As String

    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Adjust sheet name if needed

    ' Get the last row in the Email ID column (column F in this example)
    lastRow = ws.Cells(ws.Rows.Count, 6).End(xlUp).Row ' Assuming "Email ID" is in column F

    ' Create a dictionary to consolidate data by Email ID
    Set emailDict = CreateObject("Scripting.Dictionary")

    ' Loop through the rows to consolidate data by email
    For Each cell In ws.Range("F2:F" & lastRow) ' Assuming headers are in row 1
        email = cell.Value
        data = "Vendor: " & cell.Offset(0, -5).Value & ", Invoice: " & cell.Offset(0, -4).Value & _
               ", Amount: " & cell.Offset(0, -2).Value & ", Tenor: " & cell.Offset(0, -1).Value

        If emailDict.exists(email) Then
            emailDict(email) = emailDict(email) & vbCrLf & data
        Else
            emailDict.Add email, data
        End If
    Next cell

    ' Initialize Outlook
    On Error Resume Next
    Set OutlookApp = GetObject(, "Outlook.Application")
    If OutlookApp Is Nothing Then
        Set OutlookApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0

    ' Loop through the dictionary and send emails
    For Each email In emailDict.keys
        ' Create a new email
        Set MailItem = OutlookApp.CreateItem(0)
        With MailItem
            .To = email
            .Subject = "Consolidated Invoice Information"
            .Body = "Hello," & vbCrLf & vbCrLf & _
                    "Here is your consolidated invoice information:" & vbCrLf & _
                    emailDict(email) & vbCrLf & vbCrLf & _
                    "Best regards," & vbCrLf & "Your Name"
            .Send ' Use .Display instead of .Send to preview the email
        End With
    Next email

    ' Cleanup
    MsgBox "Emails sent successfully!"
    Set MailItem = Nothing
    Set OutlookApp = Nothing
    Set emailDict = Nothing
End Sub

ShareThis