根据每封电子邮件的Excel单元格值确定Outlook收件人

时间:2018-09-12 17:58:50

标签: excel outlook

无法获取.To =来填写列中的信息。我正在尝试设置运行宏时在E列中“已解决”的位置,然后到.To =将填充F列中的相邻员工ID。以下是我能够进行研究和工作的能力,但运气不好,无法根据单元格值填充“到”字段。在此先感谢您的协助。在研究过程中无法在这种精确的情况下找到任何东西。

Sub Send_Email()
    Dim rng As Range
    For Each rng In Range("E2:E22")
       If (rng.Value = "Resolved") Then
           Call mymacro(rng.Address)
       End If
    Next rng
End Sub

Private Sub mymacro(theValue As String)
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi, your issue has been resolved should issues persist please contact 611 for additional assistance."
    On Error Resume Next
    With xOutMail
        .To = Cells().Value
        .CC = ""
        .BCC = ""
        .Subject = "Your issue has been resolved."
        .Body = xMailBody
        .Display   ' using .Send for final version
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

1 个答案:

答案 0 :(得分:1)

您要使用Excel VBA实现Outlook邮件传递吗?

如果是这样, 您可以使用以下方法获取范围内的电子邮件地址。

您可以使用Sheet1.Cells获取范围内的电子邮件地址。 电子邮件地址在RNG对象的同一行中,即第一列。 Sheet1.Cells(rng.Row,1).Value

在调用mymacro(theValue As String)方法时,请将电子邮件地址传递给theValue参数。

因此,在mymacro(theValue As String)方法中,.To应该使用Value参数。

Sub Send_Email()
    Dim rng As Range
    For Each rng In Range("C1:C4")
          If (rng.Value = "2") Then
          Call mymacro(Sheet1.Cells(rng.Row, 1).Value)
       End If
    Next rng
End Sub

Private Sub mymacro(theValue As String)
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi, your issue has been resolved should issues persist please contact 611 for additional assistance."
    On Error Resume Next
    With xOutMail
        .To = theValue
        .CC = ""
        .BCC = ""
        .Subject = "Your issue has been resolved."
        .Body = xMailBody
        .Display   ' using .Send for final version
        '.Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub