Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.
Public Sub CreateAnEmail_Corp(filename As String, FullName As String, RecipentEmail As String, SupervisorEmail As String) On Error Resume Next Dim db As Database Dim rs As Recordset Dim ClientEmail As String Dim DisplayMsg As Boolean Dim AttachmentPath As String Dim objOutlook As Outlook.Application Dim objOutlookMsg As Outlook.MailItem Dim objOutlookRecip As Outlook.Recipient Dim objOutlookAttach As Outlook.Attachment Dim objOutlookExplorers As Outlook.Explorers Dim myarray() As String Dim myaddresses() As String Dim x As Integer Dim fs As Object Dim BuiltPath As String Dim response As Integer Dim WasOpen As Boolean DisplayMsg = True 'AttachmentPath = "J:\data\" & ReportCaption & ".pdf" If EnoughPrompts = 0 Then MsgBox "The email is about to be created!" & vbCrLf & _ "If nothing appears to be happening, the Outlook security box may be hiding behind an open window." & vbCrLf & _ "Click the Outlook icon on the taskbar to bring it to the front, if necessary." End If EnoughPrompts = 1 Set objOutlook = GetObject(, "Outlook.Application") 'MsgBox Err.Number & " " & Err.Description If Err.Number = 429 Then Err.Clear WasOpen = False ' Create the Outlook session. Set objOutlook = CreateObject("Outlook.Application") Else WasOpen = True End If Dim ns As Outlook.NameSpace Dim Folder As Outlook.MAPIFolder Set ns = objOutlook.GetNamespace("MAPI") Set Folder = ns.GetDefaultFolder(olFolderInbox) Set objOutlookExplorers = objOutlook.Explorers If WasOpen = False Then objOutlook.Explorers.Add Folder Folder.Display 'done opening End If AppActivate "Microsoft Outlook" ' Create the message. 'Set objOutlookMsg = objOutlook.CreateItem(olMailItem) Set objOutlookMsg = objOutlook.CreateItem(olMailItem) With objOutlookMsg 'can't do this, the mail never gets sent ' Add the from recipient(s) to the message. 'Set objOutlookRecip = .Recipients.Add(somebody) 'objOutlookRecip.Type = olOriginator ' Add the CC recipient(s) to the message. Set objOutlookRecip = .Recipients.Add(RecipentEmail) objOutlookRecip.Type = olto ' Add the CC recipient(s) to the message. Set objOutlookRecip = .Recipients.Add(SupervisorEmail) objOutlookRecip.Type = olCC ' Add the BCC recipient(s) to the message. Set objOutlookRecip = .Recipients.Add("Kelly") objOutlookRecip.Type = olBCC ' Set the Subject, Body, and Importance of the message. .Subject = "Notice of File" .BodyFormat = olFormatHTML .HTMLBody = "<p>" & FullName & "," & "</P>" .HTMLBody = .HTMLBody & "The attached Notice to File is being placed in your Personnel File for failure to complete your required training by the due date. <br><br>" .HTMLBody = .HTMLBody & "Please <a href = 'http://www.google.com'>CLICK HERE</a> to take your courses immediately. This training is mandatory and critical to ensure you are aware of important Company policies and procedures. <br><br>" .HTMLBody = .HTMLBody & "In the future, failure to complete your Compliance training by the due date may lead to disciplinary action, up to and including termination. <br><br>" .HTMLBody = .HTMLBody & "Thank you,<br><br>" .HTMLBody = .HTMLBody & "Training Team" ' Add attachments to the message. 'reportcaption is passed in and split into myarray 'one attachment needs to be added for each element in myarray AttachmentPath = "J:\data\" & filename If Not IsMissing(AttachmentPath) Then Set objOutlookAttach = .Attachments.Add(AttachmentPath) End If ' Resolve each Recipient's name. For Each objOutlookRecip In .Recipients objOutlookRecip.Resolve Next ' Should we display the message before sending? If DisplayMsg Then .Display Else .Save .Send End If End With Set objOutlook = Nothing End Sub
|Windows 10 - folders don't refresh automatically... I constantly have to type "F5"... any ideas how to fix?||31||104|
|How To Loop - Python||19||45|
|Adding to a VBA?||6||31|
|"This column type cannot be filtered" - Sharepoint 2010||3||11|
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
20 Experts available now in Live!