Just random mumbling: Adding signature other than default in outlook using VBA

Showing posts with label Adding signature other than default in outlook using VBA. Show all posts

Saturday, September 18, 2021

Adding signature other than default 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
'Default Signature
'.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

'get signature other than default
currentSig = GetBoiler(Environ("Appdata") & "\Microsoft\Signatures\demo (allsourav@hotmail.com).htm")

.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
'sFile = "C:\Users\allso\AppData\Roaming\Microsoft\Signatures\demo.htm"
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