I am using the following code to retrieve and check an email, but outlook is returning the mail starting from 12/22, which is neither the latest nor the oldest, while on a co worker's machine its picking up the oldest mail.
Set oapp = CreateObject("Outlook.Application")
Set oMAPI = oapp.GetNamespace("MAPI")
Set oInbox = oMAPI.GetDefaultFolder(6)
oInbox.Display
Set oallmails = oInbox.Items
Set oreqemail = oallmails.GetFirst
For oTotalmail = 1 To oallmails.Count
ostringmatch = oreqemail.Subject
'Using regex function to match
'If MatchString(ostringmatch,"89554 Completed") Then
'End If
'Exit For
Set oreqemail = oallmails.GetNext
Next
Am I missing any outlook setting, as the code looks ok to me.
Thanks
To be sure that you get always the latest or oldest email in Outlook you need to use the Sort method of the Items class. It sorts the collection of items by the specified property. The index for the collection is reset to 1 upon completion of this method. The name of the property by which to sort, which may be enclosed in brackets, for example, "[CompanyName]".
Note, Sort only affects the order of items in a collection. It does not affect the order of items in an explorer view.
Set oapp = CreateObject("Outlook.Application")
Set oMAPI = oapp.GetNamespace("MAPI")
Set oInbox = oMAPI.GetDefaultFolder(6)
oInbox.Display
Set oallmails = oInbox.Items
oallmails.Sort "[RecievedTime]"
Set oreqemail = oallmails.GetFirst
For oTotalmail = 1 To oallmails.Count
ostringmatch = oreqemail.Subject
'Using regex function to match
'If MatchString(ostringmatch,"89554 Completed") Then
'End If
'Exit For
Set oreqemail = oallmails.GetNext
Next
See Outlook VBA: How to sort emails by date and open the latest email found? for more information.
Related
I want to create Visual Basic scrip to create calendar event/invitation.
Script is working perfectly, when only one account is registered in outlook, and event is created OK for this single calendar (account).
PROBLEM:
I have two accounts registered in my outlook. One of the accounts is company-managed (let's call it FIRST). I have also manually created account (let's call it SECOND).
The problem is when I want to create event "on behalf" of SECOND calendar registered manually. I've already set SECOND account as primary account in outlook with:
Outlook->File->Account Settings->Account Setting...->Email Tab->Set as default.
When I'm using (almost) identical code as below to create Outlook email object, script is working perfectly fine, and field "Sender" in the message is populated with correct SECOND account name.
Picture: Email outlook object created, with SENDER populated with correct SECOND account
I've tried to set property: objAppointmentItem.SendUsingAccount = myAccount , with the SECOND account, but then Sender field is left empty, and you can't select account from combo. When I'm sending it it ANYWAY, then it is send to correct recipients, but is NOT send to my SECOND calendar (desired), and invitation/event is visible in my FIRST calendar, which I DON'T want to use anymore.
Picture: Outlook event object with FROM field empty, no selection possible
When I'm NOT setting property: objAppointmentItem.SendUsingAccount = myAccount , event object is created, but is assigned with FIRST account, despite SECOND is set as default.
Picture: Event created with wrong sender, and NO SELECTION possible for SECOND account
When I create invitation with double-click on calendar itself (SECOND account calendar), then invitation is created with correct SECOND account populated in SENDER field, (still no option to select other account - but no need, as is correct :) )
Sub OutOfOfficeEvent()
Dim oAccount As Outlook.Account
Dim myAccount As Outlook.Account
'try to find PERSONAL account. If failed, then send with last avail on the list Application.Session.Accounts
For Each oAccount In Application.Session.Accounts
Set myAccount = oAccount
If InStr(UCase(oAccount.DisplayName), "PERSONAL.COM") Then
Exit For
End If
Next
Dim objOutlookApplication As Outlook.Application
Dim objAppointmentItem As Outlook.AppointmentItem
Dim objRecipient As Recipient
Dim objRecipients As Recipients
Set objOutlookApplication = CreateObject("Outlook.Application")
Set objAppointmentItem = objOutlookApplication.CreateItem(olAppointmentItem)
'###############################################
'####### NOT working for event/invitation
'####### Working OK for email object creation
'###############################################
objAppointmentItem.SendUsingAccount = myAccount
'###############################################
objAppointmentItem.Display
Set objRecipients = objAppointmentItem.Recipients
Set objRecipient = objAppointmentItem.Recipients.Add("somebody1#PERSONAL.COM")
Set objRecipient = objAppointmentItem.Recipients.Add("somebody2#PERSONAL.COM")
objRecipient.Type = olRequired
For Each objRecipient In objAppointmentItem.Recipients
objRecipient.Resolve
Next
Dim DateStart As Date
Dim DateEnd As Date
DateStart = DateTime.DateAdd("d", 0, DateTime.DateAdd("h", 1, DateTime.DateAdd("s", -Second(Now()), DateTime.DateAdd("n", -Minute(Now()), Now()))))
DateEnd = DateTime.DateAdd("h", 1, DateStart)
With objAppointmentItem
.MeetingStatus = olMeeting
.Subject = "[OOO] " & strUser
.Start = DateStart
.End = DateEnd
.AllDayEvent = False
.ReminderSet = False
.BusyStatus = olFree
.ResponseRequested = False
.Location = ""
.Body = "Some body content"
End With
objAppointmentItem.Display
Set objOutlookApplication = Nothing
End Sub
There are several ways of creating new items in Outlook. See How To: Create a new Outlook Appointment item for more information.
If you have two accounts configured in Outlook you need to get the right calendar folder and then add a new calendar entry there. To get this done you can use the GetDefaultFolder method of the Store class which returns a Folder object that represents the default folder in the store and that is of the type specified by the FolderType argument. This method is similar to the GetDefaultFolder method of the NameSpace object. The difference is that this method gets the default folder on the delivery store that is associated with the account, whereas NameSpace.GetDefaultFolder returns the default folder on the default store for the current profile. So, you may get the right store and add the new calendar entry.
The NameSpace.Stores property returns a Stores collection object that represents all the Store objects in the current profile.
Sub EnumerateFoldersInStores()
Dim colStores As Outlook.Stores
Dim oStore As Outlook.Store
Dim oCalendar As Outlook.Folder
On Error Resume Next
Set colStores = Application.Session.Stores
For Each oStore In colStores
Set oCalendar = oStore.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar)
Debug.Print (oCalendar.FolderPath)
Next
End Sub
I had the same problem and with above suggestion and some more Google, I found the total solution:
Dim myAI As Outlook.AppointmentItem
myAI = Nothing
Dim oStore As Outlook.Store
For Each oStore In colStores
Dim oCalendar As Outlook.Folder
Set oCalendar = oStore.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar)
If LCase(oCalendar.Description) = "<accountname>" Then
Set myAI = oCalendar.Items.Add(Outlook.OlItemType.olAppointmentItem)
Exit For
End If
Next
I tried to extract the data from an Outlook email using VBA:
Sub DLPExtract()
Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As MailItem
Dim i As Integer
Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("gfdo#aviva.com\Inbox")
i = 1
For Each OutlookMail In Folder.Items
If InStr(OutlookMail.Subject, "Data Loss Prevention Report: GFDO DLP Daily Report Retrospective") > 0 And OutlookMail.ReceivedTime >= Range("From_date").Value Then
Range("Date").Offset(i, 0).Value = OutlookMail.Date
Range("Type").Offset(i, 0).Value = OutlookMail.
Range("Reference").Offset(i, 0).Value = OutlookMail.ID
Range("eMail_text").Offset(i, 0).Value = OutlookMail.Body
i = i + 1
End If
Next OutlookMail
Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing
End Sub
I want to extract only IDs in the fourth column but first need to check if that is already in the respective column on Excel sheet. If yes, do nothing and If no, then take that ID out from this fourth column in email and paste it in respective column on Excel sheet.
I believe you are trying to check the email body format.
If that is the case then follow this link which talks about the "Bodyformat" property.
Range("Type").Offset(i, 0).Value = OutlookMail.BodyFormat
It is not clear what "Type" property you are interested in - the Outlook object model doesn't provide the Type property for their items. Instead, you may be interested in the MessageClass property which returns or sets a string representing the message class for the Outlook item. The MessageClass property links the item to the form on which it is based. When an item is selected, Outlook uses the message class to locate the form and expose its properties, such as Reply commands.
Also you may be interested in the BodyFormat property which returns or sets an OlBodyFormat constant indicating the format of the body text. The body text format determines the standard used to display the text of the message. Microsoft Outlook provides three body text format options: Plain Text, Rich Text (RTF), and HTML.
Finally, there is no need to iterate over all items in the folder and checking whether they correspond to the predefined condition:
For Each OutlookMail In Folder.Items
If InStr(OutlookMail.Subject, "Data Loss Prevention Report: GFDO DLP Daily Report Retrospective") > 0 And OutlookMail.ReceivedTime >= Range("From_date").Value Then
Instead, I'd recommend using the Find/FindNext or Restrict methods of the Items class. Read more about them in the following articles:
How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
How To: Use Restrict method to retrieve Outlook mail items from a folder
I have the following code from some blog that inserts HTML from the clipboard into an outlook email.
Sub PrependClipboardHTML()
Dim email As Outlook.MailItem
Dim cBoard As DataObject
Set email = Application.ActiveInspector.CurrentItem
Set cBoard = New DataObject
cBoard.GetFromClipboard
email.HTMLBody = cBoard.GetText + email.HTMLBody
Set cBoard = Nothing
Set email = Nothing
End Sub
It works great except that the email has be in its own window (i.e. popped-out) otherwise it will fail.
I was looking around on the documentation and found Application.ActiveExplorer.ActiveInlineResponse here.
However the documentations says that it is read-only, and indeed it does not work. Is there way to get a writable version of the inline response?
It works great except that the email has be in its own window (i.e. popped-out) otherwise it will fail.
That is because you have the following statement in the code:
Set email = Application.ActiveInspector.CurrentItem
However the documentations says that it is read-only, and indeed it does not work.
Try to use the following code instead:
Set email = Application.ActiveExplorer.ActiveInlineResponse
The ActiveInlineResponse property is read-only, but not the object's properties you are going to use. That means you can't set another mail item to the inline response, but will be able to set up properties of the retrieved item.
Maybe you're trying to work with ActiveExplorer + Selection.Item Method (Outlook)
Example
Option Explicit
Public Sub Example()
Dim email As Outlook.MailItem
Set email = Application.ActiveExplorer.Selection.Item(1)
Debug.Print email.Subject ' print on immediate window
End Sub
Or Work with both opened and selected items
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
Set objApp = Nothing
End Function
You cannot concatenate two HTML strings and expect a valid HTML back. The two must be merged.
That being said, use Word Object Model to paste from the clipboard:
Application.ActiveEXplorer.ActiveInlineResponseWordEditor.Application.Selection.Paste()
In the Outlook i have create a custom form in Task form. I use it to assign task to other users. Now i try to add some code when a user not fill the assign to field (for example if the task is for him to check it when save the task and ask him if need to add himself as assigned user. My problem is that i can't update the field assigned to if it's empty.I get the error My code is the following:
Sub Item_Write(ByVal Name)
Set objPage = Item.GetInspector.ModifiedFormPages("Assign Task")
Set objControl = objPage.Controls("RecipientControl1")
Set objControl2 = objPage.Controls("Textbox1")
Set objControl4 = objPage.Controls("Textbox4")
Set oMsg = Application.CreateItem(olMailItem)
Set objNS = oMsg.Session
MyValue= objControl2.Value
MyValue4= objControl4.Value
if MyValue= "" then
if Msgbox ("Task isn't assign to anybody. Do you want to assign yourself?", vbYesNo)=vbYes then
objControl.Value=objNS.CurrentUser.Name
End if
End if
End Sub
Finally i found the solution,
I use the event Item_Close and Outlook property name for Recipient control and not Control name in Vbs. Find below my code that is working and form not close until user assign the task someone.
Function Item_Close()
Set objPage = Item.GetInspector.ModifiedFormPages("Assign Task")
Set objControl = objPage.Controls("Textbox1")
Set objNS = Application.GetNamespace("MAPI")
Set objContro2 = objPage.Controls("Frame1")
assigned=objControl.Value
'Use always Outlook property names and not Control Properties(as RecipientControl in case)
if assigned= "" then
info =Msgbox ("The task is not assigned to a user. Do you want to assign yourself?", vbYesNo)
Select Case info
Case 6
'Use always Outlook property names and not Control Properties(as RecipientControl in case)
Set myAssignedTo = Item.Recipients.Add(objNS.CurrentUser.Name)
Me.Save
Case 7
MsgBox "You must Assign Task to a user before save it.", vbExclamation
Item_Close=False
Item.GetInspector.SetCurrentFormPage "Assign Task"
End Select
End if
End Function
When using the Move method on an AppointmentItem in an Outlook macro, I lose the ability to receive updates because it is creating a copy of the item instead of truly moving it. This behavior causes the item to no longer be linked with the original and will not retain item updates as a result.
I want to replicate through VBA the cut/paste behavior you get which is able to maintain the original object and does not cause updates to be lost.
I believe this has something to do with the GlobalAppointmentID based on searching around, however I have not been able to find a way to actually move the appointment.
The code I'm using is below. GetFolderFromPath is a helper function to just return a folder object from the path, which works perfectly well.
Sub MoveItem()
Dim targetPath As String: targetPath = "\\tnolan#microsoft.com\Calendar\OOFS"
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("No item selected")
Exit Sub
Else
Dim targetFolder As Outlook.Folder
Set targetFolder = GetFolderFromPath(targetPath)
For x = 1 To Application.ActiveExplorer.Selection.Count
Dim oSelected As Variant
Set oSelected = Application.ActiveExplorer.Selection.Item(x)
If oSelected.Class = olAppointment Then
Dim NS As NameSpace: Set NS = Application.GetNamespace("MAPI")
Dim oAppt As AppointmentItem: Set oAppt = NS.GetItemFromID(oSelected.EntryID)
oAppt.Move targetFolder
Set oAppt = Nothing
Set NS = Nothing
End If
Set oSelected = Nothing
Next x
Set targetFolder = Nothing
End If
End Sub
Outlook processes incoming meeting updates/deletions only against the default Calendar folder. If you move an appointment to a different folder, meeting update in your Inbox will create a new appointment in the default Calendar folder.
After playing around with my code for a little bit, I've found that this code works for me in a similar situation:
oAppt.CopyTo(targetFolder, olCopyAsAccept)
oAppt.Delete
I have a feeling that for some reason the AppointmentItem.Move command passes as olCreateAppointment which would always create a new GlobalAppointmentID.
However, this still has a side-effect of responding accept to the Appointment.