How to create an outlook attachment in-memory using VBA - vba

I am using VBA to send an email with text attachment. Until now, I needed to physically create the file on the disk and afterwards reference its path.
Can this be done completely in mem?
Dim outlook As Object, mail As Object, path As string
Set outlook = CreateObject("Outlook.Application")
Set mail = outlook.CreateItem(0)
' write file contents
path = Environ("temp") + "\file.txt"
Open path For Output As #1
Print #1, "This is my txt"
Close #1
' attach file
With mail
.To = "me#awesome.com"
.body = "This is a test"
.attachments.Add CStr(path)
.send
End With
Set mail = Nothing
Set outlook = Nothing

The Outlook object model doesn't provide any property or method for that. The Add method of the Attachments class accepts a file path only. More precisely, the source of the attachment can be a file (represented by the full file system path with a file name) or an Outlook item that constitutes the attachment.
However, you can use a low-level API - Extended MAPI on which Outlook is built. Or consider any third-party wrappers around this API such as Redemption. The PR_ATTACH_DATA_BIN contains binary attachment data typically accessed through the Object Linking and Embedding (OLE) IStream interface. This property holds the attachment when the value of the PR_ATTACH_METHOD (PidTagAttachMethod) property is ATTACH_BY_VALUE, which is the usual attachment method and the only one required to be supported.

Related

Retrieve Outlook Attachment Document Properties using VBA

I am attempting to retrieve some built-in (even custom?) properties from Word/Excel documents in attachments without saving temp files and opening them in the respective Application. I tried attaching them in a MailItem and a DocumentItem.
The properties I am interested in would be: Author, Title, LastSaveDtm, etc. Outlook seems to be able to get them, because the Author name appears at the top of the Preview Pane of a DocumentItem.
The only way I could find to get those properties is using the following methods as described here:
varProp = MailItem.PropertyAccessor.GetProperties(SchemaName)
varProp = DocumentItem.PropertyAccessor.GetProperties(SchemaName)
varProp = MailItem.Attachments(1).PropertyAccessor.GetProperties(SchemaName)
varProp = DocumentItem.Attachments(1).PropertyAccessor.GetProperties(SchemaName)
The SchemaName's are defined in here: [MS-OXPROPS]: Exchange Server Protocols Master Property List
Some interesting definitions from the specs:
named property: A property that is identified by both a GUID and either a string name or a 32-bit identifier
Document object: A Message object that represents a single file, such as a document generated by a word-processing application. The
Message object contains the file as an Attachment object and includes
additional properties to describe the file.
The properties I am trying to retrieve do not have a MAPI tag syntax (canonical name like PidTagPropName) to be used with the proptag namespace (which works from what I have tested*) nor a MAPI id syntax (canonical name like PidLidPropName) to be used with the id namespace, but only have a MAPI string syntax (canonical name like PidNamePropName) to be used with the string namespace.
Here is what I tried for the SchemaName:
"http://schemas.microsoft.com/mapi/string/{00020386-0000-0000-C000-000000000046}/Author"
"http://schemas.microsoft.com/mapi/string/{00020329-0000-0000-C000-000000000046}/Title"
"urn:schemas-microsoft-com:office:office#Author"
"urn:schemas-microsoft-com:office:office#Title"
None of them works.
This document says that "named properties are defined by clients and occasionally service providers"
I have also seen nomewhere that document properties should be "automatically published in MAPI".
So what I am doing wrong?
(*) SchemaName's that work (PidTagSubject):
"http://schemas.microsoft.com/mapi/proptag/0x0037001E"
"http://schemas.microsoft.com/exchange/subject-utf8"
The Outlook object model, nor Redemption, doesn't provide any property or method for that.
You need to save attachments on the disk and then retrieve document properties from files. The Attachment.SaveAsFile method saves the attachment to the specified path.
Sub SaveAttachment()
Dim myInspector As Outlook.Inspector
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Set myInspector = Application.ActiveInspector
If Not TypeName(myInspector) = "Nothing" Then
If TypeName(myInspector.CurrentItem) = "MailItem" Then
Set myItem = myInspector.CurrentItem
Set myAttachments = myItem.Attachments
'Prompt the user for confirmation
Dim strPrompt As String
strPrompt = "Are you sure you want to save the first attachment in the current item to the Documents folder? If a file with the same name already exists in the destination folder, it will be overwritten with this copy of the file."
If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
myAttachments.Item(1).SaveAsFile Environ("HOMEPATH") & "\My Documents\" & myAttachments.Item(1).DisplayName
End If
Else
MsgBox "The item is of the wrong type."
End If
End If
End Sub
Note, you can automate Office applications where you can open the saved document and read the properties programmatically. See How to use a single VBA procedure to read or write both custom and built-in Document Properties for more information.

How will affect Lotus Notes GetDatabase parameters my notes account?

I would like to send e-mail with excel macro. I have read on some websites the same simple VBA code which can send the e-mail with attachment.
Sub Send_Email_via_Lotus_Notes()
Dim Maildb As Object
Dim MailDoc As Object
Dim Body As Object
Dim Session As Object
'Start a session of Lotus Notes
Set Session = CreateObject("Lotus.NotesSession")
'This line prompts for password of current ID noted in Notes.INI
Call Session.Initialize
'or use below to provide password of the current ID (to avoid Password prompt)
'Call Session.Initialize("<password>")
'Open the Mail Database of your Lotus Notes
Set Maildb = Session.GETDATABASE("", "D:\Notes\data\Mail\eXceLiTems.nsf")
If Not Maildb.IsOpen = True Then Call Maildb.Open
'Create the Mail Document
Set MailDoc = Maildb.CREATEDOCUMENT
Call MailDoc.REPLACEITEMVALUE("Form", "Memo")
'Set the Recipient of the mail
Call MailDoc.REPLACEITEMVALUE("SendTo", "Ashish Jain")
'Set subject of the mail
Call MailDoc.REPLACEITEMVALUE("Subject", "Subject Text")
'Create and set the Body content of the mail
Set Body = MailDoc.CREATERICHTEXTITEM("Body")
Call Body.APPENDTEXT("Body text here")
'Example to create an attachment (optional)
Call Body.ADDNEWLINE(2)
Call Body.EMBEDOBJECT(1454, "", "C:\dummy.txt", "Attachment")
'Example to save the message (optional) in Sent items
MailDoc.SAVEMESSAGEONSEND = True
'Send the document
'Gets the mail to appear in the Sent items folder
Call MailDoc.REPLACEITEMVALUE("PostedDate", Now())
Call MailDoc.SEND(False)
'Clean Up the Object variables - Recover memory
Set Maildb = Nothing
Set MailDoc = Nothing
Set Body = Nothing
Set Session = Nothing
End Sub
Set Maildb = Session.GETDATABASE("", "D:\Notes\data\Mail\eXceLiTems.nsf")
On my working laptop there are 10 nsf file. I dont know which should I put in the second parameter.
I have read the syntax here: https://help.hcltechsw.com/dom_designer/9.0.1/appdev/H_GETDATABASE_METHOD.html
Both can be empty string. If i would use empty string it creates a new database if I am correct. Because I would like to send each day 5 emails, I would like to send e-mails in for loop. If I use empty string, the code will create each day 5 database? I think yes, so I think I need one of the 10 nsf file use in as second parameter, so it will not create, but I dont want to crash my notes account with this.
I am quite new to notes. I used vba for outlook to send emails, and there was no database parameters.
First of all: GetDatabase will NEVER create a new database. If the database you enter exists, then your OBJECT (not the real thing, just a variable) will be created and the isOpen- Property will be true, otherwise it will be false.
You need to decide, where you want to (at least temporarily) STORE the mails you are sending.
If you set SaveMessageOnSend = True then it will be saved in that database, if you set it to False, then it will only be created in memory and NOT saved, but still you need a container for that "in Memory"- document.
Usually Mails that are created programmatically will be saved in the users' mailfile (in that case: in YOUR mailfile.
The right code for this would be:
'Initialize object without really opening a database
Set Maildb = Session.GETDATABASE("", "")
'Now open the users' mailfile
Call Maildb.OpenMail
If you have some "dummy" database to create your mails in, then you need to CREATE that database before running your script (within Notes\Data - Directory) using your Notes Client and open that one:
If you e.g. create it in mail- subdirectory of Notes\Data then it might have the absolute Path like:
C:\Program Files (x86)\HCL\Notes\Data\mail\dummy.nsf
In your script you can address it using a relative path (starting from data):
Set Maildb = Session.GETDATABASE("", "mail\dummy.nsf")
or an absolute path (doesn't really matter) like:
Set Maildb = Session.GETDATABASE("", "C:\Program Files (x86)\HCL\Notes\Data\mail\dummy.nsf")
no need of "OpenMail"- command in that case as you do not want to use the users' mailfile but the explicitely given one...
One more thing: Call MailDoc.SEND(False) already creates a PostedDate- item on your mail. No need to use the line Call MailDoc.REPLACEITEMVALUE("PostedDate", Now()).

MS Word runs on background and requests documents to be saved even though it is already saved

I have a procedure that creates a PDF file according to an ms word template and its data is retrieved from a database.
It works fine, creates a PDF file perfectly , no run time errors. The problem is that whenever I shut off the computer, ms word prevents the shutdown and if I press cancel ms word shows a message;
The code goes like this;
Dim wordApp As Word.Application
Dim templateBookmarks As Word.Bookmarks
Dim templateName As String
Dim template As Word.Document
'Some other variables for computations
wordApp = CreateObject("Word.Application")
sourceTable = New DataTable
'Some other procs to fill the data table
templateName = "Foo Template.docx"
template = wordApp.Documents.Add(templatePath & templateName)
templateBookmarks = template.Bookmarks
templateBookmarks.Item("sample bookmark").Range.Text = "foo"
'Then fills the table in the template like...
template.Tables(1).Cell(1, 1).Range.Text = dataSource.Rows(0).Item(0)
'Then saves the document as a pdf
Dim saveName As String = "sample file"
template.SaveAs2(savePath & saveName, Word.WdSaveFormat.wdFormatPDF)
I have tried to force garbage collection for the word COM resources, as well as changing the template from an actual document i.e. docx to a word template .dotx. I also tried the method Quit() but it only shows the ms word message much earlier. This is the first time I needed to use interop so pardon if I don't have much idea about it.
The files I needed are saved, the only problem is the ms word message and unsaved and unnecessary files e.g. Document1,Document2,Document3 that seems to be created aside from the required PDF
Use the Document.Close method which closes the specified document after saving files using the PDF file format. It allows specifying the SaveChanges parameter which specifies the save action for the document. Can be one of the following WdSaveOptions constants: wdDoNotSaveChanges, wdPromptToSaveChanges, or wdSaveChanges.
On Error GoTo errorHandler
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
errorHandler:
If Err = 4198 Then MsgBox "Document was not closed"

Forward Outlook email without adding signature nor From: and To: of original email

I'm looking to forward email that I receive in Outlook to a new address with no changes - an exact clone, no envelope information nor signature added.
The email will always have an HTML table in the body and needs to be preserved identically. I can get it to forward but it always adds a blank email body with a signature "above" the original email, and then there is the standard From: and To: and email attributes above the original email.
Is there a way to remove this? I have tried to change this to generate a "new" object, as the new object is not bringing in the HTML body before forwarding.
Sub Send_Forward(ByRef oMail As Object, repBodyStr As String, sendMail As
Boolean)
Dim myForward As Object
Set myForward = oMail.Forward
myForward.Subject = myForward.Subject
myForward.HTMLBody = repBodyStr & "<br>" & myForward.HTMLBody
myForward.Recipients.Add "xxx#xxx.net"
myForward.Display
ExitSub:
Set myForward = Nothing
End Sub
Create a new item (Application.CreateItem), then just copy the HTMLBody property from the existing message and add the recipients.
UPDATE: if you need to copy the attachments (such as images), you would have to save the attachments from the original message (Attachment.SaveAsFile), then add them as attachments to the new message (MailItem.Attachments.Add). Note that this will not work with embedded OLE objects (in case of the RTF format) and embedded message attachments. For the images, you would also need to copy the PR_ATTACH_CONTENT_ID MAPI property using Attachment.PropertyAccessor.
Also note MailItem.Copy would not work as the message sent state will be copied (which his not what you want).
If using Redemption (I am its author) is an option, it allows to make a copy of the message without copying its sent state. Something like the following should do the job (off the top of my head):
Set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT
set originalMsg = Session.GetRDOObjectFromOutlookObject(Application.ActiveExplorer.Selection(1))
set newMsg = Session.GetDefaultFolder(olFolderDrafts).Items.Add
'copy the message and clear out recipients
originalMsg.CopyTo(newMsg)
newMsg.Recipients.Clear
newMsg.Recipients.Add "xxx#xxx.net"
newMsg.Save
'now reopen the message in OOM and diplay it. Or you can use newMsg.Display
set myForward = Application.Session.GetItemFromID(newMsg.EntryID)
myForward.Display

How to get the email address of the current logged-in user?

I'm new to VBA and trying to get an automated word document working. At the moment there is a Button in the document that which upon pressing, will fire off an email with the document attached.
However I need to also get the email address of the current user sending the email, so I can place it inside the document before sending it off. My searches on the internet have not resulted in any usable code that meets my situation. My current code is below.
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save
With EmailItem
.Subject = "Requesting Authorization Use Overtime"
.Body = "Please review the following request for overtime" & vbCrLf & _
"" & vbCrLf & _
"Thanks"
.To = "toemail#test.com"
.Importance = olImportanceNormal
.Attachments.Add Doc.FullName
.Send
End With
Not sure if this is relevant, but when the document is being used, the Outlook application will always be open with a user signed in. Im used to having intellisense help in these sorts of situations so I can fool around with methods and properties, but there seems to be very little help from intellisense.
It all depends on the definition of "the current user address".
The address of the primary account in Outlook can be retrieved from Appication.Session.CurrentUser (returns Recipient object). Use Recipient.Address property. Note however that for an Exchange account (Recipient.AddressEntry.Type == "EX") you will receive an EX type address. To retrieve the SMTP address, use Recipient.AddressEntry.GetExchangeUser().PrimarySmtpAddress. Be prepared to handle nulls/exceptions in case of errors. This is what you most likely need in your particular case.
On the Extended MAPI level (C++ or Delphi), use IMAPISession::QueryIdentity (you can test it in OutlookSpy (I am its author) - click IMAPISession button, then QueryIdentity). You can then read the PR_ADDRTYPE property ("EX" vs "SMTP") and PR_EMAIL_ADDRESS (when PR_ADDRTYPE = "SMTP") or (in case of Exchange) PR_SMTP_ADDRESS (not guaranteed to be present) and PR_EMS_AB_PROXY_ADDRESSES (multivalued property will Exchange addresses, including all proxy (alias) addresses).
In case of multiple accounts in the profile, an email can be sent or received through multiple accounts. In that case use MailItem.SendUsingAccount (returns Account object, can be null - in that case use Application.Session.CurentUser). This is valid both for received, sent or emails being composed (Application.ActiveInspector.CurrentItem or Application.ActiveExplorer.ActiveInlineResponse).
All accounts in a given profile can be accessed using the Namespace.Accounts collection (Application.Session.Accounts). Account's address can be accessed using Account.SmtpAddress property.
Note that the Outlook Object Model only exposes mail accounts. Some store accounts (such as PST) are not in the collection since they do not have an intrinsic user identity even if some other accounts (such as POP3/SMTP) can deliver to that store. If you want to access all accounts, you can use Redemption (I am its author) and its RDOSession.Accounts collection (RDOAccounts object).
On the Extended MAPI level, the accounts are exposed through the IOlkAccountManager interface. You can play with it in OutlookSpy if you click the IOlkAccountManager button.
In case of delegate Exchange stores, the store owner is not exposed through the Outlook Object Model. You can either use Extended MAPI (note that the PR_MAILBOX_OWNER_ENTRYID property is only exposed by the online store, it is not available in a cached store). You can parse the Exchange store entry id and extract the EX type address from it. You can then construct the GAL object entry id given the EX address. You can also access the store owner using Redemption and its RDOExchangeMailboxStore object and its Owner property.
Usually, the email address is the name assigned to Outlook Mail Folders.
So try this:
'~~> add these lines to your code
Dim olNS As Outlook.NameSpace
Dim olFol AS Outlook.Folder
Set olNS = OL.GetNamespace("MAPI")
Set olFol = olNS.GetDefaultFolder(olFolderInbox)
MsgBox olFol.Parent.Name '~~> most cases contains the email address
This is assuming your are using Early Bind with the object reference properly set.
Another way to access such info is directly use Namespace properties.
MsgBox olNS.Accounts.Item(1).DisplayName '~~> usually email address
MsgBox olNS.Accounts.Item(1).SmtpAddress '~~> email address
MsgBox olNS.Accounts.Item(1).UserName '~~> displays the user name
I hope any of the above somehow helps.
This answer is for Late Binding so you don't need to have reference libraries. Place the following code in a module:
Dim OL As Object, olAllUsers As Object, oExchUser As Object, oentry As Object, myitem As Object
Dim User As String
Set OL = CreateObject("outlook.application")
Set olAllUsers = OL.Session.AddressLists.Item("All Users").AddressEntries
User = OL.Session.CurrentUser.Name
Set oentry = olAllUsers.Item(User)
Set oExchUser = oentry.GetExchangeUser()
msgbox oExchUser.PrimarySmtpAddress
Functional Approach
To make this a bit more reusable, try any return the email from a function.
Late Binding Example
''
' Creates a new instance of Microsoft Outlook to get the current users
' email address.
' Late Binding Demo.
'
' #exception If any errors it will return an optional parameter for fallback values
''
Public Function GetUsersOutlookEmail(Optional ByVal errorFallback As String = "") As String
On Error GoTo catch
With CreateObject("outlook.application")
GetUsersOutlookEmail = .GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Name
End With
Exit Function
catch:
GetUsersOutlookEmail = errorFallback
End Function
Early Binding Example
''
' Creates a new instance of Microsoft Outlook to get the current users
' email address.
' Late Binding Demo.
'
' #reference Microsoft Outlook 16.0 Object Reference
' #exception If any errors it will return an optional parameter for fallback values
''
Public Function GetUsersOutlookEmail(Optional ByVal errorFallback As String = "") As String
On Error GoTo catch
With New Outlook.Application
GetUsersOutlookEmail = .GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Name
End With
Exit Function
catch:
GetUsersOutlookEmail = errorFallback
End Function
Error Handling
Anytime you are making an API call like this, there is always a potential for errors to occur. The method I choose for these demos is to provided an optional parameter for a fallback email. This make is dynamic as you can check to see if it is null, or you could provide something such as username Environ("Username") & "#outlook.com"