Question

我有一个包含2个按钮的表单（Update＆amp; Ad）（此处的代码来自其中一个）。如果您填写表格并按其中一个，则会在其他表格中创建或更新记录。

我希望在其中嵌入电子邮件功能，以便当您按下它们时，它也会在电子邮件中发送相同的信息。

我是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的引用中使用此代码。把它放在你要发送电子邮件的地方（何时）。阅读代码正文中的注释。（我注释掉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

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

1 个答案: