I need to create outlook task from shared inbox. So far when below code runs, task is created with owner of shared inbox as I want, but when saved I get "You must be in a public folder to change the owner field of a task" error and owner is changed back to me.
I couldn't find solution or it might have been beyond my understanding. I appreciate the help. Thanks!
If task = "YES" Then
user_task = "GR"
Const olTaskItem = 3
Dim OlApp As Object
Dim OlTask As Object
Set OlApp = CreateObject("Outlook.Application")
Set OlTask = OlApp.CreateItem(olTaskItem)
With OlTask
'.Assign
'.Recipients.Add "shared#inbox.com" 'workaround to assign task for another owner, but does not show .BCC so not suitable solution.
.Owner = "shared#inbox.com" ' does not work. changes back to my user
.Subject = material_full_email & " spp "
.StartDate = Date
.DueDate = Date + 7
.Status = 1 '0=not started, 1=in progress, 2=complete, 3=waiting,
'4=deferred
.Importance = 1 '0=low, 1=normal, 2=high
.ReminderSet = False
'.ReminderTime = dtReminderDate
'.Categories = "Business" 'use any of the predefined Categorys or create your own
.Body = Date & " " & user_task & ":" & " RFQ sent: " & Supplier1 & " / " & Supplier2 & " / " & Supplier3 & " / " & Supplier4
'.Save 'use .Display if you wish the user to see the task form and make
.Display 'them perform the save
End With
End If
Instead of using Application.CreateItem, call Application.Session.CreateRecipient passing the name or address of the owner of the mailbox, call Application.Session.GetSharedDefaultFolder, then use MAPIFolder.Items.Add.
UPDATE:
Set OlApp = CreateObject("Outlook.Application")
set NS = olApp.getNamespace("MAPI")
NS.Logon
ste Recip = NS.CreateRecipient("someuser#company.demo")
set SharedFolder = NS.GetSharedDefaultFolder(Recip, olFoldersTasks)
Set OlTask = SharedFolder.Items.Add
...
I managed to get below code work. I believe biggest problem was MS Outlook library not ticked in references.
If task = "YES" Then
user_task = "GR"
Const olTaskItem = 3
Dim olApp As Object
Dim ns As Object
Dim OlTask As Object
Dim SharedFolder As Object
Set olApp = CreateObject("Outlook.Application")
Set ns = olApp.GetNamespace("MAPI")
ns.Logon
Set Recip = ns.CreateRecipient("inboxname")
Set SharedFolder = ns.GetSharedDefaultFolder(Recip, olFolderTasks)
Set OlTask = SharedFolder.Items.Add("IPM.Task")
'Set OLApp = CreateObject("Outlook.Application")
'Set OlTask = OLApp.CreateItem(olTaskItem)
With OlTask
'.Assign
'.Recipients.Add "shared#inbox.com"
'.Owner = "shared#inbox.com" ' not needed
.Subject = material_full_email & " spp "
.StartDate = Date
.DueDate = Date + 7
.Status = 1 '0=not started, 1=in progress, 2=complete, 3=waiting,
'4=deferred
.Importance = 1 '0=low, 1=normal, 2=high
.ReminderSet = False
'.ReminderTime = dtReminderDate
'.Categories = "Business" 'use any of the predefined Categorys or create your own
.Body = Date & " " & user_task & ":" & " RFQ sent to suppliers: " & Supplier1 & " / " & Supplier2 & " / " & Supplier3 & " / " & Supplier4
'.Save 'use .Display if you wish the user to see the task form and make
.Display 'them perform the save
End With
End If
I think that I have something more simple for this:
Dim objOLApp As Outlook.Application
Dim NewTask As Outlook.TaskItem
' Set the Application object
Set objOLApp = New Outlook.Application
Set NewTask = objOLApp.Session.Folders.Item(x).Items.Add(olTaskItem)
With NewTask...
Where 'x' stands for your shared inbox ID (for me this is 5). You can use MsgBox Prompt:=objOLApp.Session.Folders.Item(x) to check. It should return shared inbox adress on correct ID (adress#server.com).
Related
I have Access VBA code that creates appointments in three tech colleagues' calendars.
If vbYes = MsgBox("Send Calendar Appointments?", vbYesNo) Then
Dim outMail As Outlook.AppointmentItem
Set outMail = Outlook.CreateItem(olAppointmentItem)
outMail.Subject = "Lab Booking - " & FullName & " - for date " & Forms!frmLabSession_edit!BookingDate
outMail.Mileage = Me.LabBooking_ID
outMail.Location = Forms!frmLabSession_edit!frm_qryLabsBookedPerBooking_subform!RoomNo
outMail.MeetingStatus = olMeeting
outMail.Start = BookingDate & " " & TimeFrom
outMail.End = BookingDate & " " & TimeTo
outMail.ReminderMinutesBeforeStart = 21600
outMail.RequiredAttendees = "Person1#tees.ac.uk; Person2#tees.ac.uk; Person3#tees.ac.uk" & Me.txtCCList
outMail.Body = "You have received this notification with a 15 days countdown to cover periods of leave when you may not have received initial notification." & Chr$(13) & _
Chr$(13) & Me.Notes
outMail.Attachments.Add FileName
outMail.Send
Set outMail = Nothing
End If
I have code for deleting appointments based on the subject line, but I can't figure out how to add recipients - the other calendar users - it only removes it from my calendar.
Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim objAppointment As Outlook.AppointmentItem
Dim lngDeletedAppointements As Long
Dim strSubject As String
Dim strLocation As String
Dim dteStartDate As Date
'******************************** Set Criteria for DELETION here ********************************
strSubject = "Lab Booking - " & FullName & " - for date " & Forms!frmLabSession_edit!BookingDate
strLocation = Forms!frmLabSession_edit!frm_qryLabsBookedPerBooking_subform!RoomNo
dteStartDate = BookingDate
'************************************************************************************************
Set objOutlook = Outlook.Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderCalendar)
For Each objAppointment In objFolder.Items
If objAppointment.Subject = strSubject And objAppointment.Location = strLocation And _
objAppointment.Start > dteStartDate Then
objAppointment.Delete
lngDeletedAppointements = lngDeletedAppointements + 1
End If
Next
MsgBox lngDeletedAppointements & " appointment(s) DELETED.", vbInformation, "DETETE Appointments"
How do I declare or state in the code the attendees' calendars to remove the item from, as the top code does to send them?
I have delete rights to their calendars. I can go into their calendars and delete the appointment, so shouldn't be a permissions issue.
You may use the following sequence of action to cancel the meeting and notify attendees:
AppointmentItem.MeetingStatus = olMeetingCanceled
AppointmentItem.Save
AppointmentItem.Send
AppointmentItem.Delete
Just set the meeting canceled status which stands for - the scheduled meeting has been cancelled.
I am trying to make email using Outlook to remind someone to update their CV information per 6 months (180 days).
I have 1 query and 1 table.
Duedate_7 query consists of employee information, which passed 180 days or more since the last update. Access would send email to those employees.
Highlights table consists of the ID of the employees (Number), date of the project (date) and content of the project (long text).
Option Compare Database
Option Explicit
Function Otomail()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim emailTo As String
Dim emailSubject As String
Dim emailText As String
Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem
Dim outlookStarted As Boolean
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If outApp Is Nothing Then
Set outApp = CreateObject("Outlook.Application")
outlookStarted = True
End If
Set db = CurrentDb
Set rs1 = db.OpenRecordset("SELECT ID, NIK, Nama, email, datemailsend FROM DueDate_7")
Do Until rs1.EOF
emailTo = rs1.Fields("email")
emailSubject = "Update CV"
emailText = "Please send the newest project highlights informations of Mr/Mrs' " & rs1.Fields("Nama").Value & " to the inside sales department for updating your CV which is scheduled once per 6 months." & vbCr & _
"Your latest project highlights update was " & vbCr & _
"This email is auto generated from Task Database. Please Do Not Reply!"
Set outMail = outApp.CreateItem(olMailItem)
outMail.To = emailTo
outMail.Subject = emailSubject
outMail.Body = emailText
outMail.Display
rs1.Edit
rs1!datemailsend = Date
rs1.Update
rs1.MoveNext
Loop
rs1.Close
Set rs1 = Nothing
Set db = Nothing
Set outMail = Nothing
Set outApp = Nothing
End Function
I want to include each of the employee's 3 latest project highlights, stored in Highlights table, in each of the email I send.
What you need to do is to use a second recordset inside the loop that you have already got that selects the information required. Something like:
If Not (rs1.BOF And rs1.EOF) Then
Do
strProject = ""
strSQL = "SELECT TOP 3 ProjectName, ProjectDate " _
& " FROM Highlights " _
& " WHERE NameID=" & rs1!NameID _
& " ORDER BY ProjectDate DESC;"
Set rsProject = db.OpenRecordset(strSQL)
If Not (rsProject.BOF And rsProject.EOF) Then
Do
strProject = strProject & rsProject!ProjectDate & vbTab & rsProject!ProjectName & vbCrLf
rsProject.MoveNext
Loop Until rsProject.EOF
End If
Set outMail = outApp.CreateItem(olMailItem)
outMail.To = rs1!email
outMail.Subject = "Update CV"
outMail.Body = emailText & strProject
outMail.Display
rs1.MoveNext
Loop Until rs1.EOF
End If
This is assuming that you have a field called NameID that identifies the person to be selected.
Regards,
I convert a worksheet into a PDF and am trying to have that PDF emailed to me and copied to another person. All of this will be assigned to an action button/trigger.
Option Explicit
Sub SendExcelFileAsPDF()
Dim OutlookApp As Outlook.Application
Dim emItem As Object
Dim Receipt As String, Subject As String
Dim Message As String, Fname As String
Dim Recipient As Outlook.Recipient
Recipient = "xxxxx.xxxxx#fedex.com"
Subject = "Weekly Critical Items" & " " & Range("L1")
Message = Range("D2") & Range("J2") & "Weekly Critical Items submitted" &
Range("L1") & " " & "in PDF Format"
Message = Message & vbNewLine & vbNewLine & "Offload Ops"
Fname = Application.DefaultFilePath & "/" & ActiveWorkbook.Name & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fname
Set OutlookApp = New Outlook.Application
Set emItem = OutlookApp.CreateItem(olMailItem)
With emItem
.To = Recipient = "xxxxx.xxxxx#fedex.com"
.Subject = Subject
.Body = Message
.Attachements.Add Fname
.Send
End With
Set OutlookApp = Nothing
End Sub
The recipient line is where I am having issues. When I run the debugger, it's giving
Run-Time error '91: Object variable or with block variable not set
I would dim recipient as string and update the .to assignment:
Change
Dim Recipient As Outlook.Recipient
.To = Recipient = "dennis.aikens#fedex.com"
to
Dim Recipient As string
.To = Recipient
This line
.To = Recipient = "dennis.aikens#fedex.com"
Should be just
.To = Recipient
This Outlook macro is supposed to, when the local folder has 5 emails, ask the user to move them to a public shared folder and delete the original 5 emails.
I keep getting this "Operation failed" error message on the line below.
**Set NewFolder = myFolder.CopyTo(PblcSharedFolder)**
From comment: This line is meant to copy the entire folder of five emails.
Sub MoveEmail()
Dim app As New Outlook.Application
Dim nameSpace As Outlook.nameSpace
Dim currentExplorer As Outlook.Explorer
Dim currentSelection As Outlook.selection
Dim currentMailItem As MailItem
Dim emailCopy As MailItem
Dim myFolder
Dim PblcSharedFolder As MAPIFolder
Dim NewFolder As MAPIFolder
Dim i As Integer
Dim folderName
Dim mailboxNameString
Dim result
folderName = "Local Folder"
mailboxNameString = "My Inbox Name"
Set nameSpace = app.GetNamespace("MAPI")
Set currentExplorer = app.ActiveExplorer
Set currentSelection = currentExplorer.selection
Set myFolder = nameSpace.Folders(mailboxNameString).Folders("Inbox").Folders(folderName)
If (myFolder.Items.Count = 5) Then
result = MsgBox("Would you like to move the content of your Local folder to the Public-shared Folder?", vbYesNo)
If result = vbYes Then
Set PblcSharedFolder = nameSpace.GetDefaultFolder(olPublicFoldersAllPublicFolders)
Set PblcSharedFolder = PblcSharedFolder.Folders("Subfolder")
Set PblcSharedFolder = PblcSharedFolder.Folders("Public Shared Folder")
Set NewFolder = myFolder.CopyTo(PblcSharedFolder)
NewFolder.Name = "_" & nameSpace.CurrentUser.Name & " " & Now
For i = myFolder.Items.Count To 1 Step -1
myFolder.Items(i).Delete
Next i
Else
Stop
End If
End If
For i = 1 To currentSelection.Count
Set currentMailItem = currentSelection.Item(i)
Debug.Print "[" & Date & " " & Time & "] moving #" & m & _
": xfolder = " & folderName & _
"; subject = " & currentMailItem.Subject & "..."
currentMailItem.To = nameSpace.CurrentUser.Name
currentMailItem.Move myFolder
Next i
End Sub
untested!
If result = vbYes Then
Set PblcSharedFolder = nameSpace.GetDefaultFolder(olPublicFoldersAllPublicFolders)
Set PblcSharedFolder = PblcSharedFolder.Folders("Subfolder")
Set PblcSharedFolder = PblcSharedFolder.Folders("Public Shared Folder")
Dim myCopiedItem As Outlook.MailItem
For i = myFolder.Items.Count To 1 Step -1
Set myCopiedItem = myFolder.Items(i).Copy
myCopiedItem.Move PblcSharedFolder
myFolder.Items(i).Delete
Next i
Else
Stop
End If
I did to be honest not quite unterstand what this line is for:
NewFolder.Name = "_" & nameSpace.CurrentUser.Name & " " & Now
I'm trying to send automated emails through outlook from Access, but I've run into an issue where if a user does not have their email open already, I will get the Application-Defined or Object-Defined Error. I'm using a late binding to avoid the .dll's since I have users on both Office 2003 and Office 2010.
Is there anyway around this error and still allowing the emails to go through? Or possibly "forcing" outlook to open if it is not already?
Thanks in advance
Sure thing, here's the whole code to the email.
When I step through it fails at Set appOutlookRec = .Recipients.Add(myR!Email)
Option Explicit
Function SendEmail(strDep, strIssue, strPriority, strDate, strDesc, wonum, user)
Const olMailItem = 0
Const olTo = 1
Const olCC = 2
Dim sqlVar As String
Dim strSQL As String
If strDep = "Cycle" Then
ElseIf strDep = "Fabrication" Then
sqlVar = "Fabricator"
ElseIf strDep = "Facility" Then
sqlVar = "Facility"
ElseIf strDep = "Gage" Then
sqlVar = "Gage"
ElseIf strDep = "IT" Then
sqlVar = "IT"
ElseIf strDep = "Machine Shop" Then
sqlVar = "Machine_Shop_Manager"
ElseIf strDep = "Safety" Then
sqlVar = "Safety"
ElseIf strDep = "Maintenance" Then
sqlVar = "Maintenance_Manager"
ElseIf strDep = "Supplies Request" Then
sqlVar = "Supplies"
Else:
End If
Dim myR As Recordset
'Refers to Outlook's Application object
Dim appOutlook As Object
'Refers to an Outlook email message
Dim appOutlookMsg As Object
'Refers to an Outlook email recipient
Dim appOutlookRec As Object
'Create an Outlook session in the background
Set appOutlook = CreateObject("Outlook.Application")
'Create a new empty email message
Set appOutlookMsg = appOutlook.CreateItem(olMailItem)
'Using the new, empty message...
With appOutlookMsg
strSQL = "SELECT Email FROM Employees WHERE " & sqlVar & " = True"
Set myR = CurrentDb.OpenRecordset(strSQL)
Do While Not myR.EOF
Set appOutlookRec = .Recipients.Add(myR!Email)
appOutlookRec.Type = olTo
myR.MoveNext
Loop
strSQL = "SELECT Email FROM Employees WHERE '" & user & "' = Username"
Set myR = CurrentDb.OpenRecordset(strSQL)
Set appOutlookRec = .Recipients.Add(myR!Email)
appOutlookRec.Type = olCC
.Subject = wonum
.Body = "Department: " & strDep & vbNewLine & vbNewLine & _
"Issue is at: " & strIssue & vbNewLine & vbNewLine & _
"Priority is: " & strPriority & vbNewLine & vbNewLine & _
"Complete by: " & strDate & vbNewLine & vbNewLine & _
"Description: " & strDesc
.Send
End With
Set myR = Nothing
Set appOutlookMsg = Nothing
Set appOutlook = Nothing
Set appOutlookRec = Nothing
End Function
Try using .Save before .Send. I was scheduling outlook code through MS Access.
After the line Set appOutlook = CreateObject("Outlook.Application"), add the following:
set NS = appOutlook.GetNamespace("MAPI")
NS.Logon
So what appears to be happening is your reference to the Outlook.Application is- well. stagnant- for lack of a better word. You don't just want to create an Outlook Session - you want to connect to an existing running application.
I'm not a pro on Access, so I'll just suggest generalities: Try to Obtain a handle on an already running Outlook Application, otherwise have it open Outlook (Give it time to fully startup using sleep/wait and a DoEvents command) and try again to obtain that handle.
I was using VBA within Outlook attempting to read the sender names (also getting the same error). Traced it down to my method of obtaining the current outlook application handle.
Instead of:
Set appOutlook = CreateObject("Outlook.Application");
I had to:
Set appOutlook = ThisOutlookSession;
Hope this helps!