Question

我有一个包含7个工作表的工作簿。我有以下vba在特定工作表上符合值后发送电子邮件。

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

提前致谢

设为General（声明）

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

后跟一个模块一般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

Answer 1

根据我的理解，你试图“告诉方法”一点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。

从Excel发送多封电子邮件

1 个答案: