从Excel发送多封电子邮件
我有一个有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是什么。 只需将parameter passing给如下函数：
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
编辑2：我改变了一下代码，如果你需要任何帮助，让我知道。
编辑：好的，这是你如何解决这个问题。 在“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
你在每张表中都有一个button，根据调用macros的表单，你想要发送不同的电子邮件，对吧？ 那么这将做到这一点。 你可以添加任意数量的ElseIf 。