Sub SendHyperEmail()
Dim vCode, vFld2, vFld5, vFld6
Dim vTo, vSubj, vBody
Dim iLastRow As Long
Const Q = """"
'goto last row
Range("A1").Select
'Selection.End(xlDown).Select
vBody = "The RESPONSE column of the Employee Onboarding worksheet was modified on <br>"
vBody = vBody & "Date=" & Format(Date, "mm/dd/yyyy") & "<br><br>"
vBody = vBody & "<a href=" & Q & "https://my.sharepoint.com/?/r/personal/_layouts" & Q & ">RESPONSE column</a>"
vTo = "wile.E.coyote@acme.com" 'or range("A7").value
vSubj = "your data"
'send email
Send1Email vTo, vSubj, vBody
End Sub
'-------
'YOU MUST ADD THE OUTLOOK APP IN REFERENCES!!! checkmark OUTLOOK OBJECTS in the vbE menu, Tools, References
'-------
Public Function Send1Email(ByVal pvTo, ByVal pvSubj, ByVal pvBody, Optional pvFile) As Boolean
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem
On Error GoTo ErrMail
Set oApp = GetApplication("Outlook.Application")
'Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(olMailItem)
With oMail
.To = pvTo
.Subject = pvSubj
.HTMLBody = pvBody
'.Body = pvBody
If Not IsMissing(pvFile) Then .Attachments.Add pvFile, olByValue, 1
.Display True
'or
'.Send
End With
Send1Email = True
Set oMail = Nothing
Set oApp = Nothing
Exit Function
ErrMail:
MsgBox Err.Description, vbCritical, Err
'Resume Next
Set oApp = Nothing
End Function
Function GetApplication(className As String) As Object
' function to encapsulate the instantiation of an application object
Dim theApp As Object
On Error Resume Next
Set theApp = GetObject(, className)
If Err.Number <> 0 Then
'MsgBox "Unable to Get" & className & ", attempting to CreateObject"
Set theApp = CreateObject(className)
End If
If theApp Is Nothing Then
Err.Raise Err.Number, Err.Source, "Unable to Get or Create the " & className & "!"
Set GetApplication = Nothing
End If
'MsgBox "Successfully got a handle on Outlook Application, returning to caller"
Set GetApplication = theApp
End Function
