从Excel发送多封电子邮件

Trace 发表于 Dev

跟踪

我有一个包含7个工作表的工作簿。一旦在特定工作表上满足一个值，我就可以通过下面的vba发送电子邮件。

每张纸都有不同的值和要发送的附件。如何为每个工作表添加代码，以便发送电子邮件？

提前致谢

设置为常规（声明）

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Application.Intersect(Range("M4:M368"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 3500 Then
            Call Fuel_LevelW03
        End If
    End If
End Sub

随后是模块General Fuel_LevelW03

Sub Fuel_LevelW03()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

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

    strbody = "Hi" & vbNewLine & vbNewLine & _
              "Please order fuel as attached." & vbNewLine & _
              "" & vbNewLine & _
              "Kind Regards" & vbNewLine & _
              ""

    On Error Resume Next
    With OutMail
        .To = "email address"
        .CC = "email address"
        .BCC = ""
        .Subject = "Fuel Order W03"
        .Body = strbody
        .Attachments.Add ("H:\Fuel Order Sheets\Glen Eden W03 Pump Station.xlsx")
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

伯纳德·索西尔

据我了解，您尝试对方法进行“讲述” Target.Value。只需将参数传递给函数，如下所示：

If IsNumeric(Target.Value) Then
    If Target.Value < 3500 Then
        Call Fuel_LevelW03( Sh.Name, Target.Value )
    End If
End If

并使用此名称更改函数名称：

Fuel_LevelW03( sheetName as String, targetValue as String )
                                                   'Change String to appropriate type

EDIT2：如果您需要任何帮助，请稍稍更改一下代码。

编辑：好的，这是您解决的方法。在“ ThisWorkbook”代码对象内（在工作表代码对象下方，在代码编辑器的左侧），将其粘贴：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Application.Intersect(Range("M4:M368"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value < 3500 Then
            Call Fuel_LevelW03( Sh.Name )
        End If
    End If
End Sub

Sub Fuel_LevelW03( sheetName as String )
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

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


    On Error Resume Next

    If sheetName = "Sheet1" Then 'Replace Sheet1 with the name of your worksheet

        strbody = "Hi" & vbNewLine & vbNewLine & _
              "Please order fuel as attached." & vbNewLine & _
              "" & vbNewLine & _
              "Kind Regards" & vbNewLine & _
              "STRING BODY1"

        With OutMail
            .To = "email address"
            .CC = "email address"
            .BCC = ""
            .Subject = "Fuel Order W03"
            .Body = strbody
            .Attachments.Add ("H:\Fuel Order Sheets\Glen Eden W03 Pump Station.xlsx")
            .Send
        End With
        On Error GoTo 0

    ElseIf sheetName = "Sheet2" Then 'Replace Sheet2 with the name of the next sheet and 

        'Put the same content as the first IF statement, but adapted to "Sheet2"

    ElseIf sheetName = "Sheet3" Then 'Replace Sheet3 with the name of the next sheet and 

        'Put the same content as the first IF statement, but adapted to "Sheet3"

    ElseIf sheetName = "Sheet4" Then 'Replace Sheet4 with the name of the next sheet and 

        'Put the same content as the first IF statement, but adapted to "Sheet4"

    'ElseIf ............. (So on, so forth)


    End If

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

您可以根据需要添加任意多个ElseIf（每张纸一个）

尽管不确定，但可以肯定这是您所需要的。

If ActiveSheet.Name = "Sheet1" Then

    'Do something specific to "Sheet1"

ElseIf ActiveSheet.Name = "Sheet2" Then

    'Do something specific to "Sheet2"

    'And so on so forth...

End If

您在每个工作表中都有一个指向该宏的按钮，并且根据要调用该宏的工作表，您希望发送不同的电子邮件，对吗？然后就可以了。您可以根据需要添加任意多个ElseIf。

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。