Question

我有一个vba代码，用于发送带附件的电子邮件。我现在需要更改它，以便它将附加工作簿中不同工作表的行。 VBA如下：

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 = ""
        .BCC = ""
        .Subject = "Fuel Order Glen Eden 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

更改活动代码

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

Answer 1

如果我理解正确的话。首先，您需要将工作表复制到另一个工作簿，然后需要保存它。最后，您可以通过此信息发送电子邮件。

示例：

Const MY_SHEET_NAME As String = "BD"
Const BD_PATH As String = "c:\myLocation\"

Sub doAll()
    Dim OutApp As Object, OutMail As Object, strbody As String
    Dim path As String

    ' Create a file
    Sheets(MY_SHEET_NAME).Activate
    Sheets(MY_SHEET_NAME).Copy

    path = BD_PATH & "report" & Format(Now, "yyyyMMdd") & ".xlsx"
    ActiveWorkbook.SaveAs Filename:=path, FileFormat:=xlOpenXMLWorkbook

    ' Send e-mail
    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 = ""
        .BCC = ""
        .subject = "Fuel Order Glen Eden W03"
        .body = strbody
        .Attachments.Add ("H:\Fuel Order Sheets\Glen Eden W03 Pump Station.xlsx")
        .Attachments.Add (path) '<--- Adding new sheet.
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

从excel发送电子邮件，该电子邮件附加来自不同工作表的行

1 个答案: