bradyboyy88
Well-known Member
- Joined
- Feb 25, 2015
- Messages
- 562
I am using VBA in excel to send an outlook email. I have my default outlook account for my personal email but I also have a shared email address in outlook which multiple can send emails from. I am sending the email from the shared email account and all works great but using VBA to do this saves the sent message in my personal sent box. So I am trying to use the SaveSentMessageFolder to save the email to the sent folder of the shared mailbox but I keep getting the error: -2147024891 : You don't have appropriate permission to perform this operation surrounding the SaveSentMessageFolder line. My code is below. How do I grant permission via vba to use this command or is there a solution which doesnt require permission?
Code:
'Create Email
'Generate Outlook Email for L&E
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim OutDestFolder As Outlook.MAPIFolder
Dim QuitNewOutlook As Boolean
Dim myInspector As Outlook.Inspector
Dim Session As Outlook.Namespace
On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If OutApp Is Nothing Then
Set OutApp = CreateObject("Outlook.Application")
QuitNewOutlook = True
End If
Set Session = OutApp.GetNamespace("MAPI")
Session.Logon
On Error GoTo OutlookErrors
Set OutMail = OutApp.CreateItem(0)
Set OutlookEventClass.oMailItem = OutMail
'Set destination folder for sending. Shared folders addresses dont automatically save in sent so we need to do it manually
Set OutDestFolder = Session.Folders("SharedEmailAddress@email.com").Folders("Sent Items")
With OutMail
.SentOnBehalfOfName = "SharedEmailAddress@email.com"
.To = FORM1.ToTextBox_Email.Text
.CC = FORM1.CCTextbox_EMAIL.Text
.BCC = FORM1.BCCTextbox_EMAIL.Text
.Subject = FORM1.SubjectTextbox_EMAIL.Text
.Body = FORM1.BodyTextbox_EMAIL.Text
If Not FORM1.AttachmenLabel_EMAIL.Tag = "" Then
.Attachments.Add (FORM1.AttachmenLabel_EMAIL.Tag)
End If
.SaveSentMessageFolder = OutDestFolder 'This is where the error is triggered
.Send
End With
