CODEWITHSUNDEEP
vbaexcelemail
user3425887
user3425887

Reputation: 33

Excel Email the range this button copies

I have a form that has 2 buttons (Update & Ad) (the code under here is from one of them). If you fill out the form and press one of them, a record in an other sheet gets made or updated.

I would like to have a email function embedded in them so that when you press them it also sends the same info in an email.

I'm new to VBA. This was a workbook that I downloaded from the internet and changed to fit my needs. So I'm not the designer of this code but I see that Set myCopy = inputWks.Range("OrderEntry") is the data that I need. How do I paste this in the body of a email?

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

Upvotes: 1

Views: 106

Answers (1)

M--
M--

Reputation: 28993

You can use this code in reference to here. Put this where (when) you want to send the email. Read the comments in the body of the code. (I commented out the OnError Blocks for debugging, uncomment them when you are using the code).

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

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

    With olMail
        .To = "[email protected]" '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

Upvotes: 2

Related Questions