VBA-通过基于单元格数据的Outlook发送电子邮件

Question

I've been failing miserably trying to write code for this, so I'd be happy if someone could help me create a macro in excel. I'm looking to send a bunch of users access credentials through outlook based off data I add to excel. Specifically, I have two worksheets:

1) Email Information (all static)

This contains:

• Email Subject in cell C5
• Email Body in Cell C6 (Essentially this says Hello, your user credentials are below)
• Additional Email Body in Cell C7 (This portion would say something along the lines of "please let us know if you have any questions") Both cells C6 and C7 can of course be updated to include any language

2) User Information (number of users can vary)

This contains:

• Column A - First Name
• Column B - Last Name
• Column C - Full Name (Not really needed)
• Column D - Email Address
• Column E - Password

Ideally, the macro would be able to look at the user information and create a new, separate email from outlook for every email address from column D with the following format:

• Email To: email addresses in cell D2 until last email (User Information worksheet)
• Email Subject: Cell C5 in Email information worksheet
• "Hi" Firstname value from column A in User Information worksheet
• Email Body Part 1 from cell C6 in Email Information worksheet
• Username: which is the email address from column D (same as email recipient)
• Password: from column E in User Information worksheet
• Email Body PArt 2 from cell C7 in Email Information worksheet

Hope someone has the time to help me out.

Thanks in advance!!

EDIT

Thanks for the help, Barry. Here is my code as I'm trying to reference two different worksheets. Can you let me know what I'm doing wrong?

Sub GenerateEmail()
Dim sEmailBodyp1 As String
Dim sEmailBodyp2 As String
Dim sEmailSubject As String
Dim sEmailTo As String
Dim sFirstName As String
Dim sPassword As String
Dim OutApp As Object
Dim OutMail As Object
Dim EmailSheet As Worksheet
Dim UserSheet As Worksheet
Dim UsedRange As Range

Set EmailSheet = Sheets("Email Information")
Set UserSheet = Sheets("User Information")
Set sEmailSubject = EmailSheet.Cells("C5")
Set sEmailBodyp1 = EmailSheet.Cells("C6")
Set sEmailBodyp2 = EmailSheet.Cells("C7")
Set UsedRange = UserSheet.UsedRange

For Each Row In UsedRange.Rows
    sFirstName = Row.Columns(1)
    sEmailTo = Row.Columns(4)
    sPassword = Row.Columns(5)
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = sEmailTo
        .Subject = sEmailSubject
        .Body = "Hi " + sFirstName + "," + vbCrLf + vbCrLf + sEmailBodyp1 + vbCrLf + vbCrLf + "Username: " + sEmailTo + vbCrLf + "Password: " + sPassword + vbCrLf + vbCrLf + sEmailBodyp2
        .Display
    End With

    Set OutMail = Nothing
Next

Set OutApp = Nothing

End Sub

Answer 1

Based on discussions this is my edit for this solution.

Excel Macro

Public Sub GenerateEmail()
Dim sEmailBodyp1 As String
Dim sEmailBodyp2 As String
Dim sEmailSubject As String
Dim sEmailTo As String
Dim sFirstName As String
Dim sPassword As String
Dim OutApp As Object
Dim OutMail As Object
Dim EmailSheet As Worksheet
Dim UserSheet As Worksheet
Dim UsedRange As Range

Set EmailSheet = Sheets("Email Information")
Set UserSheet = Sheets("User Information")

sEmailSubject = EmailSheet.Range("C5").Value
sEmailBodyp1 = EmailSheet.Range("C6").Value
sEmailBodyp2 = EmailSheet.Range("C7").Value

Set UsedRange = UserSheet.UsedRange

For Each Row In UsedRange.Rows.Offset(1, 0).Resize(UsedRange.Rows.Count - 1, UsedRange.Columns.Count)

        sFirstName = Row.Columns(1)
        sEmailTo = Row.Columns(4)
        sPassword = Row.Columns(5)
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)

        With OutMail
            .To = sEmailTo
            .Subject = sEmailSubject
            .Body = "Hi " + sFirstName + "," + vbCrLf + vbCrLf + sEmailBodyp1 + vbCrLf + vbCrLf + "Username: " + sEmailTo + vbCrLf + "Password: " + sPassword + vbCrLf + vbCrLf + sEmailBodyp2
            .Display
        End With

        Set OutMail = Nothing

Next

Set OutApp = Nothing
End Sub