VBA-通过基于单元格数据的Outlook发送电子邮件 [英] VBA - Sending Emails Through Outlook Based on Cell Data

问题描述

我一直为此尝试编写代码而失败，所以如果有人可以帮助我在excel中创建宏，我会很高兴.我希望根据我添加到excel中的数据，通过Outlook发送大量用户访问凭据.具体来说，我有两个工作表:

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)电子邮件信息(均为静态)

1) Email Information (all static)

其中包含:

• 在单元格C5中发送电子邮件主题
• 单元格C6中的电子邮件正文(本质上说，您好，您的用户凭据在下面)
• 单元格C7中的其他电子邮件正文(此部分将说明请问您是否有任何疑问")，当然可以对单元格C6和C7进行更新，以包括任何语言.

2)用户信息(用户数可以变化)

2) User Information (number of users can vary)

其中包含:

• A列-名
• B列-姓氏
• C列-全名(并非真正需要)
• D列-电子邮件地址
• E列-密码

理想情况下，该宏将能够查看用户信息，并使用以下格式为D列中的每个电子邮件地址从Outlook创建新的独立电子邮件:

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:

• 电子邮件收件人:单元格D2中的电子邮件地址，直到最后一封电子邮件为止(用户信息工作表)
• 电子邮件主题:电子邮件信息工作表中的单元格C5
• 用户信息"工作表A列中的"Hi"姓氏值
• 电子邮件信息工作表中单元格C6中的电子邮件正文第1部分
• 用户名:这是D列中的电子邮件地址(与电子邮件收件人相同)
• 密码:来自用户信息工作表中的E列
• 电子邮件信息工作表中单元格C7中的电子邮件正文部分2

希望有人有时间帮助我.

Hope someone has the time to help me out.

提前谢谢！

EDIT

EDIT

感谢您的帮助，Barry.这是我尝试引用两个不同工作表时的代码.你能让我知道我在做什么错吗?

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

结束子

推荐答案

基于讨论，这是我对该解决方案的修改.

Based on discussions this is my edit for this solution.

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

这篇关于VBA-通过基于单元格数据的Outlook发送电子邮件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！