Question

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

我是编码的新手，并且已经击中了一些作家的作品＃34;试图克服这个问题。任何帮助将不胜感激。

Answer 1

我觉得我很挣扎，因为我试图在一个Sub中做到这一点，它开始变得太杂乱了。相反，我把它分解成更容易跟随的部分。以下是我最终决定解决这个问题的方法（我省略了排序部分和安排收件人姓名的功能）：

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

通过电子邮件发送Excel - 每个不同名称的电子邮件

1 个答案: