Question

目前我有一张工作表可以将电子邮件发送到特定的电子邮件地址，在此工作表上有一个具有两个选项的特定验证列表。如果我选择一个选项，它将向指定的电子邮件发送电子邮件。但是，如果我选择第二个选项，则不会发生任并且没有错误。

我希望能够根据列表中选择的内容向工作表发送两个不同的电子邮件地址，然后按“发送”按钮。

代码：

Private Sub CommandButton1_Click()

If Sheet1.Range("G31") = "in the cell(see notes below)" Then

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
Dim fName As String

fName = " NIFU - " & ws.Range("Q12") & " " & Format(Now, "ddmmyyyy hhmmss") & ".xls"

ThisWorkbook.SaveAs fPath & fName, xlWorkbookNormal

' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
' This example sends the last saved version of the Activeworkbook object .
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
   ' Change the mail address and subject in the macro before you run it.
    With OutMail
        .To = "JABAAR.ALI@ "
        .CC = ""
        .BCC = ""
        .Subject = "RESTRICTED:"
        .Body = "Hello," & vbNewLine & vbNewLine
        .Attachments.Add ActiveWorkbook.FullName
        ' You can add other files by uncommenting the following line.
        '.Attachments.Add ("C:\test.txt")
        ' In place of the following statement, you can use ".Display" to
        ' display the mail.
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing


    MsgBox "Thank you, this referral has been sucessfully sent"

    Else

    If Sheet1.Range("G31") = "Multiple applicants registered at the same address" Then

   ' Change the mail address and subject in the macro before you run it.
    With OutMail
        .To = "JABAAR.ALI@__________ "
        .CC = ""
        .BCC = ""
        .Subject = "RESTRICTED:"
        .Body = "Hello," & vbNewLine & vbNewLine
        .Attachments.Add ActiveWorkbook.FullName
        ' You can add other files by uncommenting the following line.
        '.Attachments.Add ("C:\test.txt")
        ' In place of the following statement, you can use ".Display" to
        ' display the mail.
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

    MsgBox "Thank you, this referral has been sucessfully sent"

           End If
    End If
End Sub

Answer 1

我只是弄清楚为什么它根本不起作用。您需要在IF的两个分支内声明和设置对象。它现在的设置方式，你将它们声明在顶部块中，而不是在底部块中。

您还需要在Else部分中包含这些行：

dim OutApp as object
Set OutApp = CreateObject("Outlook.Application")
dim OutMail as object
set OutMail = OutApp.CreateItem(0)

尝试使用此代码：

Private Sub CommandButton1_Click()

If Sheet1.Range("G31") = "in the cell(see notes below)" Then

    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
    Dim fName As String

    fName = " NIFU - " & ws.Range("Q12") & " " & Format(Now, "ddmmyyyy hhmmss") & ".xls"

    ThisWorkbook.SaveAs fPath & fName, xlWorkbookNormal

    ' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
    ' This example sends the last saved version of the Activeworkbook object .
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    ' Change the mail address and subject in the macro before you run it.
    With OutMail
        .To = "JABAAR.ALI@ "
        .CC = ""
        .BCC = ""
        .Subject = "RESTRICTED:"
        .Body = "Hello," & vbNewLine & vbNewLine
        .Attachments.Add ActiveWorkbook.FullName
        ' You can add other files by uncommenting the following line.
        '.Attachments.Add ("C:\test.txt")
        ' In place of the following statement, you can use ".Display" to
        ' display the mail.
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing


    MsgBox "Thank you, this referral has been sucessfully sent"

ElseIf Sheet1.Range("G31") = "Multiple applicants registered at the same address" Then

    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    ' Change the mail address and subject in the macro before you run it.
    With OutMail
        .To = "JABAAR.ALI@__________ "
        .CC = ""
        .BCC = ""
        .Subject = "RESTRICTED:"
        .Body = "Hello," & vbNewLine & vbNewLine
        .Attachments.Add ActiveWorkbook.FullName
        ' You can add other files by uncommenting the following line.
        '.Attachments.Add ("C:\test.txt")
        ' In place of the following statement, you can use ".Display" to
        ' display the mail.
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

    MsgBox "Thank you, this referral has been sucessfully sent"

End If
End Sub

Answer 2

我已将Outlook变量初始化为If语句之外的内容，现在似乎可以正常工作。

Private Sub CommandButton1_Click（）

将OutApp作为对象调暗设置OutApp = CreateObject（“Outlook.Application”）昏暗的OutMail作为对象设置OutMail = OutApp.CreateItem（0）

如果单元格中的Sheet1.Range（“G31”）=“（请参阅下面的注释）”那么

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
Dim fName As String

fName = " NIFU - " & ws.Range("Q12") & " " & Format(Now, "ddmmyyyy hhmmss") & ".xls"

ThisWorkbook.SaveAs fPath & fName, xlWorkbookNormal

' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
' This example sends the last saved version of the Activeworkbook object .
Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
' Change the mail address and subject in the macro before you run it.
With OutMail
    .To = "JABAAR@"
    .CC = ""
    .BCC = ""
    .Subject = "RESTRICTED:"
    .Body = "Hello," & vbNewLine & vbNewLine
    .Attachments.Add ActiveWorkbook.FullName
    ' You can add other files by uncommenting the following line.
    '.Attachments.Add ("C:\test.txt")
    ' In place of the following statement, you can use ".Display" to
    ' display the mail.
    .Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing


MsgBox "Thank you, this referral has been sucessfully sent"

ElseIf Sheet1.Range（“G31”）=“在同一地址注册的多个申请人”然后

' Change the mail address and subject in the macro before you run it.
With OutMail
    .To = "JABAAR.ALI@__________ "
    .CC = ""
    .BCC = ""
    .Subject = "RESTRICTED:"
    .Body = "Hello," & vbNewLine & vbNewLine
    .Attachments.Add ActiveWorkbook.FullName
    ' You can add other files by uncommenting the following line.
    '.Attachments.Add ("C:\test.txt")
    ' In place of the following statement, you can use ".Display" to
    ' display the mail.
    .Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

MsgBox "Thank you, this referral has been sucessfully sent"

结束如果结束子

excel vba发送电子邮件验证列表

2 个答案: