Excel 通过电子邮件发送此按钮复制的范围

Question

我有一个包含 2 个按钮（更新和广告）的表单（此处的代码来自其中一个按钮）。如果您填写表格并按下其中一个表格，则会生成或更新另一张表格中的记录。

我想在其中嵌入一个电子邮件功能，这样当您按下它们时，它也会在电子邮件中发送相同的信息。

我是 VBA 新手。这是我从互联网上下载并更改以适应我的需要的工作簿。所以我不是这段代码的设计者，但我看到Set myCopy = inputWks.Range("OrderEntry") 是我需要的数据。如何将其粘贴到电子邮件正文中？

Sub UpdateLogRecord()

    Dim historyWks As Worksheet
    Dim inputWks As Worksheet

    Dim lRec As Long
    Dim oCol As Long
    Dim lRecRow As Long

    Dim myCopy As Range
    Dim myTest As Range

    Dim lRsp As Long

    Set inputWks = Worksheets("Input")
    Set historyWks = Worksheets("Werknemers")
    oCol = 3 'order info is pasted on data sheet, starting in this column

    'check for duplicate order ID in database
    If inputWks.Range("CheckID") = False Then
      lRsp = MsgBox("Personeelsnummer niet in de database. record toevoegen?", vbQuestion + vbYesNo, "Nieuw Personeelsnummer")
      If lRsp = vbYes Then
        UpdateLogWorksheet
      Else
        MsgBox "Selecteer een Personeelsnummer uit de database."
      End If

    Else

    'cells to copy from Input sheet - some contain formulas
    Set myCopy = inputWks.Range("OrderEntry")

    lRec = inputWks.Range("CurrRec").Value
    lRecRow = lRec + 1

    With inputWks
        Set myTest = myCopy.Offset(0, 2)

        If Application.Count(myTest) > 0 Then
            MsgBox "Please fill in all required cells!"
            Exit Sub
        End If
    End With

    With historyWks
        With .Cells(lRecRow, "A")
            .Value = Now
            .NumberFormat = "mm/dd/yyyy hh:mm:ss"
        End With
        .Cells(lRecRow, "B").Value = Application.UserName
        oCol = 3

        myCopy.Copy
        .Cells(lRecRow, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
        Application.CutCopyMode = False
    End With

    'clear input cells that contain constants
    With inputWks
      On Error Resume Next
         With myCopy.Cells.SpecialCells(xlCellTypeConstants)
              .ClearContents
              Application.GoTo .Cells(1) ', Scroll:=True
         End With
      On Error GoTo 0
      If .Range("ShowMsg").Value = "Yes" Then
         MsgBox "Database is geupdated"
      End If
    End With
  End If
End Sub

Answer 1

您可以参考here 使用此代码。将其放在您要发送电子邮件的位置（时间）。阅读代码正文中的 cmets。 （我注释掉了OnError块进行调试，使用代码时取消注释）。

    'On Error GoTo PROC_EXIT
    Dim OL As New Outlook.Application

    Dim olMail As Outlook.MailItem
    Set olMail = OL.CreateItem(olMailItem)

    With olMail
        .To = "kensmith@hotmail.com" 'you want the email to be sent to this address
        .Subject = "test-emai" 'Subject of the email (can be referred to a cell)
        .Body = myCopy

        'This line displays the email
        'comment this and uncomment next line to send the email

        .Display vbModal 
        '.Send
    End With

 'PROC_EXIT:
    'On Error GoTo 0
    OL.Quit
    Set OL = Nothing