I have different accounts in my Outlook.
Depending on the currently selected folder, I would like to find the smtp Email address of the corresponding account.
(Folder name is no help)
I know how to get the smtp email address of an account:
(olApp.Session.CurrentUser.AddressEntry.GetExchangeUser.PrimarySmtpAddress)
I know how to get the current selected folder or even its store name:
(olApp.ActiveExplorer.CurrentFolder.store.DisplayName)
but I can't find how to link both information...
Any idea ?
thx :)
Private Sub storeAddress_from_DisplayName()
Dim storeDisplayName As String
Dim storeSMTPAddress As String
Dim storeRecipient As Recipient
' DisplayName and PrimarySmtpAddress can be the same
storeDisplayName = ActiveExplorer.CurrentFolder.Store.DisplayName
Debug.Print " storeDisplayName: " & storeDisplayName
Set storeRecipient = Session.CreateRecipient(storeDisplayName)
If storeRecipient.AddressEntry.Type = "EX" Then
storeSMTPAddress = storeRecipient.AddressEntry.GetExchangeUser.PrimarySmtpAddress
Debug.Print " storeSMTPAddress: " & storeSMTPAddress
End If
End Sub
In theory, you could parse the EX store entry id to extract the EX address and then use it to build the GAL entry id that you can use to call Namespace.GetAddressEntryFromID. You can see how the store entry is parsed (in C++) in the MFCMAPI source code.
If using Redemption (I am its author) is an option, it exposes RDOExchangeMailboxStore.Owner property (returns RDOAddressEntry object, which in turn exposes the SMTPAddress property):
Set MySession = CreateObject("Redemption.RDOSession")
MySession.MAPIOBJECT = Application.Session.MAPIOBJECT
set Store = MySession.GetStoreFromID(Application.ActiveExplorer.CurrentFolder.StoreID)
MsgBox Store.Owner.SmtpAddress
Related
I'm exporting/extracting mail failure items located in a subfolder named 'Subfolder' to a local folder on my laptop using this Outlook code:
Private Sub DBC1()
Set inbox = Session.GetDefaultFolder(6).Folders("Subfolder")
For Each m In inbox.Items
intCount = m.Attachments.Count
If intCount > 0 Then
For i = 1 To intCount
m.Attachments.Item(i).SaveAsFile "C:\info\" & _
m.Attachments.Item(i).FileName
Next
End If
Next
End Sub
I need to change the sender address. How do I change the 'From' value?
Even though you can open an MSG file using Namespace.OpenSharedItem, Outlook Object Model will not let you modify the sender related properties using MailItem.PropertyAccessor.SetProperty (it likes being the Big Brother who knows best).
If using Redemption (I am its author) is an option, you can use RDOSession.GetMessageFromMsgFile to open an MSG file (returns RDOMail object), then either wipe out the sender setting RDOMail.Sender / SentOnBehalfOf to Nothing (null) or set them to a valid RDOAddressEntry object.
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
My overall goal is to change the "From" sender on an incoming email to something else. Specifically, I get chat logs from Zopim chat and they're all coming from Zopim's "no-reply" email. However, I want these chat logs to be associated with in my CRM and thus I want them associated to people who we chat with.
I've created this VBA script, it runs without errors, however, no change is done to the incoming email. What am I doing wrong?
Option Explicit
Sub ZopimChatMessageRule(Item As Outlook.MailItem)
Dim body As String
Dim sndr As String
On Error GoTo Finally
body = Trim(Right(Item.body, Len(Item.body) - (InStrRev(Item.body, "EMAIL") + 5)))
sndr = Trim(Left(body, InStr(body, vbCrLf) - 1))
Item.sender.Address = sndr
Item.sender.Name = sndr
Item.sender.Update
Item.Recipients.ResolveAll
Item.Save
Finally:
End Sub
Your code is updating the name and address of a one-off address entry that does not exist anywhere. What you need to do is change the Sender and SentOnBehalfOf properties, which are read-only in the Outlook Object Model.
You can use MailItem.PropertyAccessor.SetProperty to update dozen or so PR_SENDER_xyz and PR_SENT_REPRESENTING_xyz MAPI properties - take a look at a message with OutlookSpy (I am its author - click IMessage button). Keep in mind that SetProperty will prevent you from modifying some properties Outlook considers "special".
If using Redemption is an option (I am also its author), you can set the Sender and SentOnBehalfOf properties directly:
set rSession = CreateObject("Redemption.RDOSession")
rSession.MAPIOBJECT = Application.Session.MAPIOBJECT
set Msg = rSession.GetRDOObjectFromOutlookObject(Item )
strEntryID = rSession.AddressBook.CreateOneOffEntryID("Fake User", "SMTP", "someuser#fake.domain.com", false, true)
set addressEntry = rSession.AddressBook.GetAddressEntryFromID(strEntryID)
Msg.Sender = addressEntry
Msg.SentOnBehalfOf = addressEntry
Msg.Save
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"
I have some VBA code that takes the various email parts as inputs and creates an email message in Lotus Notes, and sends it from a group mailbox. It sends the email out to a recipient and CC recipients, and then leaves a copy of the message in the "Sent" box of a group email account. I think the sent message in that box is sort of a dummy, as it is perhaps not the exact message as it was sent.
This works, and sends the message to the SendTo, and to the first CC address. However, if I have a second CC address, it turns the ending of the second address into gibberish. For example, if the SendTo is "mike#someemail.com", and the CC is "john#someemail.com, jim#someemail.com"... in the Sent box it appears to have sent it to mike#someemail.com, and CC to john#someemail.com and jim#someemail.com. However, the actual mail is only received by john, and the CC looks like this: "john#someemail.com, jim#pps.rte_to_v" and jim never gets the message.
On another message, the second CC ends up being jim#vwall11.com. I haven't found a pattern to the gibberish it puts at the end of the CC line instead of the correct address. It took us awhile to learn about the problem since it looks correct in the Sent mailbox.
Here's the code I'm using. I'm changing the server names, etc, but all relevant code is intact.
Private Sub TestEmail()
Call EmailFromADT("mike#somemail.com", "john#somemail.com, jim#somemail.com", "test subject", "test message", _
"", "", "", "")
End Sub
Function EmailFromADT(strSendTo As String, strCopy As String, strSubject As String, _
strText1 As String, strText2 As String, strText3 As String, _
strText4 As String, strText5 As String)
Dim notesdb As Object
Dim notesdoc As Object
Dim notesrtf As Object
Dim notessession As Object
Dim i As Integer
Set notessession = CreateObject("Notes.Notessession")
''''''''Group Mailbox'''''''''''''''''''''''''''''''''''''''''''''''''
Set notesdb = notessession.GetDatabase("servername", "mailin\notesaddr.nsf")
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Open the mail database in notes
If notesdb.IsOpen = True Then
'Already open for mail
Else
notesdb.OPENMAIL
End If
Set notesdoc = notesdb.CreateDocument
Call notesdoc.ReplaceItemValue("Subject", strSubject)
Set notesrtf = notesdoc.CreateRichTextItem("body")
Call notesrtf.AppendText(strText1 & vbCrLf & strText2 & vbCrLf & strText3 & vbCrLf & strText4 & vbCrLf & strText5)
notesdoc.SendTo = strSendTo
notesdoc.CopyTo = strCopy
notesdoc.from = UserName()
''''''''Group Mailbox'''''''''''''''''''''''''''''''''''''''''''''''''
notesdoc.principal = "Group Team"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
notesdoc.BlindCopyTo = strBCC
Call notesdoc.Save(True, False)
notesdoc.SaveMessageOnSend = True
Call notesdoc.Send(False, strSendTo)
Set notessession = Nothing
End Function
To have multiple values in an item in a Document, you need to use an array.
Try this:
dim varCopyTo as Variant
varCopyTo = Split( strCopyTo, "," )
call notesDoc.Replaceitemvalue( "CopyTo", varCopyTo )
You could also write notesDoc.CopyTo=varCopyTo, but it is better (more secure, slightly better performance) to use ReplaceItemValue.
In addition you should add Call notesDoc.ReplaceItemValue("Form", "Memo" ) after creating the document, so that the server/client does not have to "guess" what kind of document you are creating.
notesdoc.CopyTo wants an array, not a comma-delimted string on the right hand side of the assignment. Each element in the array should be an individual address. By passing in a comma-delimited string, you're essentially passing in a single invalid address as far as Notes and Domino are concerned. I'm not entirely sure why that's being transformed in the peculiarly random way that it is, but I am sure it's definitely not going to be right that way.
And better than using the shorthand form (notesdoc.CopyTo = ...) for this code, you should probably be using Call notesdoc.ReplaceItemValue, like you do with the Subject, but passing in an array there.