Sub SendEmail(Optional fArr, Optional Action = "Show", Optional SensLabel = "Unrestricted")
' Don't forget to copy the function GetBoiler in the module.
' https://www.rondebruin.nl/win/s1/outlook/signature.htm
' http://www.vbaexpress.com/forum/showthread.php?52440-Inserting-non-default-signature-with-picture-in-Outlook-e-mail -modifying signature to work with E-mail.
' Working in Office 2000-2016
' Relies on module RdB_Email (Ron deBruin) - https://www.rondebruin.nl/win/s1/outlook/openclose.htm
' 12-Jul-2023 - WshShell.SendKeys is used rather than simply SendKeys to avoid unintended toggling of the NumLock key. MB.
Dim OutApp As Object
Dim OutMail As Object
Dim SigString As String
Dim Signature As String
Dim WshShell As Object
Dim I As Integer
Screen.MousePointer = 11
' Pause below is required to prevent intermittent "Server Execution Failed" errors. Solution found - 15-Dec-22.
Pause (2)
' Set OutApp = CreateObject("Outlook.Application")
Set OutApp = OutlookApp()
If IsM365 = True Then
Set OutMail = getVbaTemplateMail("VBA Template - Sensitivity=General")
Dim olFolder As Outlook.MAPIFolder
Dim olItem As Outlook.MailItem
' Dim OutMail As Outlook.MailItem
'GetDefaultFolder(16) = Draft folder, "Drafts/VBA Templates" is my VBA Template folder
' Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(16).Folders("VBA Templates")
Set olFolder = OutApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders("VBA Templates")
For Each olItem In olFolder.Items
If SensLabel = "ECI" Then
If olItem.SUBJECT = "VBA Template - Sensitivity=_ECI" Then
Set OutMail = olItem.Copy
'If error "Active Inline Response" appears, the mail is open in Outlook, close it first!
End If
Else
If olItem.SUBJECT = "VBA Template - Sensitivity=Unrestricted" Then
Set OutMail = olItem.Copy
'If error "Active Inline Response" appears, the mail is open in Outlook, close it first!
End If
End If
Next
Else ' Not M365
Set OutMail = OutApp.CreateItem(0)
End If
SigString = Environ("appdata") & "\Microsoft\Signatures\CompanyName.htm"
If LenB(Dir(SigString)) <> 0 Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
On Error Resume Next
With OutMail
If Action = "Show" Then
.Display
' If IsM365 = True Then
' ' https://stackoverflow.com/questions/25977933/sendkeys-is-messing-with-my-numlock-key-via-vba-code-in-access-form
' Set WshShell = CreateObject("WScript.Shell")
' WshShell.SendKeys "%h" ' Alt H - gets the home menu
' WshShell.SendKeys "AY" ' Sensitivity Label
' If SensLabel = "ECI" Then
' WshShell.SendKeys "{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}{RIGHT}{ENTER}" ' Export Controlled'
' Else
' WshShell.SendKeys "{ENTER}" ' Change the number of {DOWN} to select a particular value from your list - Unrestricted
' End If
' Set WshShell = Nothing
' End If
End If
.To = EmailTo
.CC = EmailCC
.BCC = EmailBCC
.SUBJECT = EmailSubject
.HTMLBody = strbody & Signature
' .WindowState = olMinimized
' does not seem to work - would like to use olNormal or olNormalWindow but those don't work either.
If LenB(AttachFile) <> 0 Then .Attachments.ADD AttachFile
If LenB(AttachFile1) <> 0 Then .Attachments.ADD AttachFile1
If LenB(AttachFile2) <> 0 Then .Attachments.ADD AttachFile2
' Both of the statements below seem to evaluate to true - i.e. the for loop is executed, but the code seems to work normally.
' If Not IsEmpty(fArr) Then
If UBound(fArr) <> 0 Then
For I = 1 To UBound(fArr)
.Attachments.ADD fArr(I)
Next
End If
' .OriginatorDeliveryReportRequested = True ' delivery confirmation
' .ReadReceiptRequested = True ' read confirmation
' Commented out Send - it now pops up a confirmation dialog.
' If Action = "Send" Then
' https://www.rondebruin.nl/win/s1/security.htm - Send gives a warning message that you have to display.
' '.Send
' .Display
' Pause (2)
' SendKeys "%s"
If Action = "Save" Then
' If IsM365 = True Then
' .Display
' Set WshShell = CreateObject("WScript.Shell")
' WshShell.SendKeys "%h" ' Alt H - gets the home menu
' WshShell.SendKeys "AY" ' Sensitivity Label
' If SensLabel = "ECI" Then
' WshShell.SendKeys "{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}{DOWN}{RIGHT}{ENTER}" ' Export Controlled'
' Else
' WshShell.SendKeys "{ENTER}" ' Change the number of {DOWN} to select a particular value from your list - Unrestricted
' End If
' Set WshShell = Nothing
' Pause (2)
' ' https://www.mrexcel.com/board/threads/vba-e-mail-window-close.865000/
' .Close olSave
' Else ' Not M365
.Save
' End If
End If
End With
Screen.MousePointer = 1
On Error GoTo 0
' Variables should be reset in the calling procedure.
'EmailTo = ""
'OutMail.Quit - Not supported
Set OutMail = Nothing
'OutApp.Quit Closes Outloook
Set OutApp = Nothing
End Sub
