Vba 从Excel发送电子邮件-每个不同名称发送一封电子邮件

我有一个按名称排序的工作表。有些名称可能有多行数据，有些名称可能只在一行中找到。我想浏览一下这张工作表，从每行中提取3条数据，并使用这些数据构建电子邮件的正文。我只想每人发一封电子邮件。 因此，如果下一行上的名称与我不想发送电子邮件的当前行相匹配，我想从该行中提取我需要的3条数据，并将其保存到从上一行抓取的数据中，然后再次评估这是否是此人的最后一行

---

我对编码是新手，在试图克服这个问题时遇到了一些“编写障碍”。任何帮助都将不胜感激。

我想我很挣扎，因为我试图在一艘潜艇上完成，但它开始变得太混乱了。相反，我把它分解成更容易理解的部分。下面是我最终决定解决这个问题的方法（我省略了排序部分和一个安排收件人姓名的函数）：

Sub-EDBRemitMain（）
昏暗的光线和长的一样多
暗淡如长
首先，我们将对数据进行排序
呼叫EDBRemitSort
'计算该工作表有多少行数据：
范围（“A1”）。选择
选择。结束（xlDown）。选择
lRowCount=ActiveCell.Row
'我们将从第2行开始，因为工作表始终有一个标题行。
对于lCount=2到lRowCount
调用EDBRemitEmailBody（lCount、lRowCount）
下一个帐户
端接头
子EDBRemitEmailBody（lCount为长，lRowCount为长）
昏暗的车身1
昏暗的车身2
作为货币的Dim CRUNNING总计
将sDate设置为字符串
Dim lTripNum尽可能长
像细绳一样暗淡的浮渣
货币
将sNameEval1变为字符串
将sNameEval2变为字符串
'重置cRunningtotal
cRunningTotal=0
'运行，直到不再有数据行。
直到lCount=lRowCount+1为止
'设置我们将在电子邮件正文中使用的总金额、客户、行程号和日期，并更新运行总数。
sDate=单元（lCount，4）
sCustomer=单元格（lCount，8）
cTotal=单元格（lCount，29）
lTripNum=单元格（lCount，1）。值
cRunningTotal=cRunningTotal+cTotal
'开始构建电子邮件正文
BodyEmail1=“Hello”&“”&“您将报销以下费用，总金额为€”&cRunningTotal&“
”
BodyEmail2=BodyEmail2&“”&sDate&&sCustomer&&&cTotal&&http://url/linking/to/a/detailed/BreakdownOfExpenses.aspx?TripID=“&lTripNum&”
”
'设置用于查看下一行中的名称是否与当前行中的名称匹配的变量。
单元格（lCount，3）。激活
sNameEval1=ActiveCell.Value
sNameEval2=ActiveCell.Offset（1,0）
如果sNameEval1 sNameEval2那么
致电EdbSendmail（BodyEmail1、BodyEmail2、lCount）
出口接头
其他的
如果结束
lCount=lCount+1
环
端接头
子EdbSendmail（BodyEmail1、BodyEmail2、lCount）
像绳子一样模糊
暗淡的A外观为对象
将电子邮件作为对象
设置aOutlook=CreateObject（“Outlook.Application”）
设置aEmail=aOutlook.CreateItem（0）
'抓取要翻转的名称，将其输入到函数中并返回
sName=FlipNames（单元格（lCount，3）.Value）
带着电子邮件
.Subject=“差旅报销”
.HTMLBody=BodyEmail1和BodyEmail2
.To=sName
.BCC=“我要找的人”
对于测试，我们将显示电子邮件，而不是自动发送。
"展示,
.发送
以
设置aOutlook=Nothing
端接头

您可以分享一些您尝试过的东西吗？您可以构建一个唯一名称数组，并使用它们发送电子邮件。或者，您可以捕获一个名称，检查它是否与表示上一个值的变量匹配。最初，它将是空的，当它们不匹配时，您希望它发送。完成后，将当前名称放入上一个值中，然后获取下一个值并再次比较。。。。直到你到达列表的末尾。

Sub EDBRemitMain()

Dim lRowCount As Long
Dim lCount As Long


'First we will sort the data
Call EDBRemitSort

'Figure out how many rows of data the sheet has:
Range("A1").Select
Selection.End(xlDown).Select
lRowCount = ActiveCell.Row


'We will start on row 2 since the worksheet will always have a header row.
For lCount = 2 To lRowCount
    Call EDBRemitEmailBody(lCount, lRowCount)
Next lCount

End Sub

Sub EDBRemitEmailBody(lCount As Long, lRowCount As Long)
Dim BodyEmail1
Dim BodyEmail2
Dim cRunningTotal As Currency
Dim sDate As String
Dim lTripNum As Long
Dim sCustomer As String
Dim cTotal As Currency
Dim sNameEval1 As String
Dim sNameEval2 As String

'Reset  cRunningtotal
cRunningTotal = 0


'Run until there are no more rows of data.
Do Until lCount = lRowCount + 1

    'Set the total amount, customer, trip number, and date we will use in the email's body, and update the running total.
        sDate = Cells(lCount, 4)
        sCustomer = Cells(lCount, 8)
        cTotal = Cells(lCount, 29)
        lTripNum = Cells(lCount, 1).Value
        cRunningTotal = cRunningTotal + cTotal

        'Start building the body of the email
        BodyEmail1 = "Hello" & "<p>" & "You are being reimbursed for the following expenses, for which the total amount is <B>€" & cRunningTotal & "</B></p>"
        BodyEmail2 = BodyEmail2 & "<p>" & sDate & " " & sCustomer & " " & "€" & cTotal & " " & "http://url/linking/to/a/detailed/BreakdownOfExpenses.aspx?TripID=" & lTripNum & "</p>"


    'Set variables that we will use to see if the name in the next row matches the name on the current row.
    Cells(lCount, 3).Activate
    sNameEval1 = ActiveCell.Value
    sNameEval2 = ActiveCell.Offset(1, 0)
    If sNameEval1 <> sNameEval2 Then
        Call EDBSendEmail(BodyEmail1, BodyEmail2, lCount)
        Exit Sub
    Else
    End If

    lCount = lCount + 1
Loop

End Sub

Sub EDBSendEmail(BodyEmail1, BodyEmail2, lCount)


Dim sName As String
Dim aOutlook As Object
Dim aEmail As Object


Set aOutlook = CreateObject("Outlook.Application")

Set aEmail = aOutlook.CreateItem(0)


'Grab the names we want to flip, feed it into our function and return
sName = FlipNames(Cells(lCount, 3).Value)


    With aEmail
    .Subject = "Trip Reimbursement"
    .HTMLBody = BodyEmail1 & BodyEmail2
    .To = sName
    .BCC = "Person I am BCCing"
    'For the test we will Display the emails rather than automatically sending them.
    '.Display
    .Send

    End With




Set aOutlook = Nothing


End Sub