Friday, September 17, 2021

Adding default signature at the end of the mail in outlook using VBA

     'Used with GetDefaultFolder of the NameSpace
    Public Const olFolderCalendar = 9 'The Calendar folder.
    Public Const olFolderConflicts = 19 'The Conflicts folder (subfolder of the Sync Issues folder). Only available for an Exchange account.
    Public Const olFolderContacts = 10 'The Contacts folder.
    Public Const olFolderDeletedItems = 3 'The Deleted Items folder.
    Public Const olFolderDrafts = 16 'The Drafts folder.
    Public Const olFolderInbox = 6 'The Inbox folder.
    Public Const olFolderJournal = 11 'The Journal folder.
    Public Const olFolderJunk = 23 'The Junk E-Mail folder.
    Public Const olFolderLocalFailures = 21 'The Local Failures folder (subfolder of the Sync Issues folder). Only available for an Exchange account.
    Public Const olFolderManagedEmail = 29 'The top-level folder in the Managed Folders group. For more information on Managed Folders, see the Help in Microsoft Outlook. Only available for an Exchange account.
    Public Const olFolderNotes = 12 'The Notes folder.
    Public Const olFolderOutbox = 4 'The Outbox folder.
    Public Const olFolderSentMail = 5 'The Sent Mail folder.
    Public Const olFolderServerFailures = 22 'The Server Failures folder (subfolder of the Sync Issues folder). Only available for an Exchange account.
    Public Const olFolderSuggestedContacts = 30 'The Suggested Contacts folder.
    Public Const olFolderSyncIssues = 20 'The Sync Issues folder. Only available for an Exchange account.
    Public Const olFolderTasks = 13 'The Tasks folder.
    Public Const olFolderToDo = 28 'The To Do folder.
    Public Const olPublicFoldersAllPublicFolders = 18 'The All Public Folders folder in the Exchange Public Folders store. Only available for an Exchange account.
    Public Const olFolderRssFeeds = 25 'The RSS Feeds folder.

Sub setoutlookNS()
Dim txtHtmlDemo, currentSig As String

Dim olApp, olAccts, olInspect As Object
Set olApp = CreateObject("Outlook.Application")
Dim olFolder As Outlook.MAPIFolder
Set olFolder = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Dim olNewMail As Outlook.MailItem
Set olNewMail = olFolder.Items.Add 'creating new mail
'currentSig = "<br/>Thank You<br/><br/>Sourav Bhattacharya"

With olNewMail
'.SentOnBehalfOfName = """Sourav IT Faculty"" <allsourav@gmail.com>"
Set olInspect = olNewMail.GetInspector 'activates email,prompts signature to appear,not display
currentSig = .HTMLBody 'contains nothing but signature now

.To = "allsourav2@gmail.com;allsourav@gmail.com;"
.CC = "souravandamiya@gmail.com"

.Subject = "Happy Birthday on 14.09.2021"
.Body = "Wish you a happy birthday ,\n learning outlook using python again"
.Importance = 2
.ReadReceiptRequested = True
.OriginatorDeliveryReportRequested = True

Set olAccts = olApp.Session.Accounts
For Each olAcct In olAccts
If olAcct.SmtpAddress = "allsourav@gmail.com" Then
.SendUsingAccount = olAcct
Exit For
End If


Next olAcct
'MsgBox (olApp.Session.Accounts.Count)
txtHtmlDemo = Application.GetOpenFilename()

.BodyFormat = 2 'olFormatHTML
'.HTMLBody = "<html><h2>The body <span style='color:red'>of <b>Our Email </b></span></h2> <body>Regular Stuff Here <br/> New Line </body></html>"
'.HTMLBody = "<h2>Welcome To The Best Online HTML Web Editor!</h2><p style=""font-size: 1.5em;"">You can <strong style=""background-color: #317399; padding: 0 5px; color: #fff;"">type your text</strong> directly in the editor or paste it from a Word Doc, PDF, Excel etc.</p><p style=""font-size: 1.5em;"">The <strong>visual editor</strong> on the right and the <strong>source editor</strong> on the left are linked together and the changes are reflected in the other one as you type! <img src=""https://html5-editor.net/images/smiley.png"" alt=""smiley"" /></p>"
'.HTMLBody = Sheets("Sheet1").Range("htmlBody1")
.HTMLBody = GetBoiler(txtHtmlDemo) & "<br />" & currentSig

.Display
'.Send


End With

End Sub


Function GetBoiler(ByVal sFile As String) As String

Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readAll
ts.Close



End Function




No comments:

Post a Comment