logic2design
1/29/2019 - 4:46 AM

Send email from Form

Private Sub Command66_Click()
Const strParent = "\\prod.atonet.gov.au\atonetshares$\Individuals_Automation\Requests\Output\"

Dim olApp As Object
Dim objMail As Object
     Dim strID As String
     Dim strDate As String
     Dim strOfficer As String
     Dim strFolder As String
     Dim strRisk As String
     Dim strUserID As String
On Error Resume Next 'Keep going if there is an error

' Request
     strTitle = Me.Title
     strID = Me.ID
     strDate = Me.Request_Date
     strOfficer = Me.Officer
     strRisk = Me.Request_Risk
     strUserID = Me.Officer_UserID
     ' Full path
     strFolder = "<a href='" & strParent & strOfficer & "\" & strID & " - " & strRisk & " - " & strTitle & "'>Results</a>"
     strBody = "<html><body><p>Hi,</p><p>Please find at the link below the results of your data request.</p>" _
    & strFolder & "<p>Any queries please let me know.</p>Regards</body></html>"
    
Set olApp = GetObject(, "Outlook.Application") 'See if Outlook is open


If Err Then 'Outlook is not open
Set olApp = CreateObject("Outlook.Application") 'Create a new instance of Outlook
End If

'Create e-mail item
Set objMail = olApp.CreateItem(olMailItem)

With objMail
.Display
'Set body format to HTML
.BodyFormat = olFormatHTML
.To = strUserID
.Subject = strID & " " & strOfficer & " - " & strRisk & " - " & strTitle
.htmlBody = strBody & .htmlBody
.send

End With
'MsgBox "Results email has been sent"
End Sub