Thank you in advance!
I want to extract emails from Outlook. I'm a complete begginer
I tried this code which was already there but was not working properly, showing an Error code (438).
Option Explicit
Sub ExtraerCorreos()
Dim OutlookApp As Object
Dim ONameSpace As Object
Dim MyFolder As Object
Dim OItem As Object
Dim Fila As Integer
Dim Fecha As Date
Set OutlookApp = New Outlook.Application
Set ONameSpace = OutlookApp.GetNamespace("MAPI")
Set MyFolder = ONameSpace.GetDefaultFolder(olFolderInbox)
Fila = 2
Fecha = "24/01/2023"
For Each OItem In MyFolder.Items
If Int(OItem.ReceivedTime) >= Fecha Then
Sheets("Hoja1").Cells(Fila, 1).Value = OItem.SenderEmailAddress
Sheets("Hoja1").Cells(Fila, 2).Value = OItem.Subject
Sheets("Hoja1").Cells(Fila, 3).Value = OItem.ReceivedTime
Sheets("Hoja1").Cells(Fila, 4).Value = OItem.Body
End If
Fila = Fila + 1
Next OItem
Set OutlookApp = Nothing
Set ONameSpace = Nothing
Set MyFolder = Nothing
End Sub
Thank you!
In the code you are iterating over all items in the folder:
For Each OItem In MyFolder.Items
If Int(OItem.ReceivedTime) >= Fecha Then
Sheets("Hoja1").Cells(Fila, 1).Value = OItem.SenderEmailAddress
Sheets("Hoja1").Cells(Fila, 2).Value = OItem.Subject
Sheets("Hoja1").Cells(Fila, 3).Value = OItem.ReceivedTime
Sheets("Hoja1").Cells(Fila, 4).Value = OItem.Body
End If
Keep in mind that Outlook folders may contain different kind of items - mails, appointments, notes and etc. So, there is a high risk to use a property on an object which doesn't provide such property or method.
The error 438 occurs when you try to use a property or method that does not support by that object. as you know all objects have some properties and methods that you can use but there could be a situation when using a property or method that does not apply to a particular object.
So, I'd suggest checking the item type or message class (see the MessageClass property) before processing an item in the loop, so you could be sure such properties do exist, for example:
For Each OItem In MyFolder.Items
If TypeName(OItem) = "MailItem" Then
Set oMail = oItem
'do stuff with omail
End If
Next
Also, instead of iterating over all items and checking the ReceivedTime property in the loop you can use the Find/FindNext or Restrict methods of the Items class. They allow getting items that correspond to the search criteria, so you will iterate only through the items you need. Read more about these methods in the articles I wrote for the technical blog:
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
You declared Fecha as a date but assigned Fecha= "24/01/2023" which is a string. Try Fecha = #24/01/2023# or Fecha = DateValue("24/01/2023")
Related
All the reply (RE:) and the forward (FWD:) mails received in a shared inbox has to automatically move to an "Ongoing folder".
This code is not working.
Private Sub Application_NewMail()
Dim olNameSpace As NameSpace
Set olNameSpace = GetNamespace("MAPI")
Dim olDestFolder As Folder
Set olDestFolder = olNameSpace.Folders("xxx#gmail.com").Folders("Ongoing")
Dim olLookUpFolder As Folder
Set olLookUpFolder = olNameSpace.Folders("xxx#gmail.com").Folders("Inbox")
' olMail is a Class. Avoid as a variable name
'Dim olMail As MailItem
Dim olObj As Object ' Outlook items are not necessarily mailitems
For Each olObj In olLookUpFolder.Items 'loop through Tickets folder to find original mail
If olObj.Class = olMail Then
Set objMail = objItem
v = objMail.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x10810003")
If (v = 102) Or (v = 104) Then
olObj.Move olDestFolder ' move to InProgress folder
Exit For
End If
End If
Next
End Sub
Firstly, do not use "for each" against a collection that you are modifying (by calling MailItem.Move). Use a down loop.
Secondly, never loop through all items in a folder (you wouldn't use a SELECT query in SQL without a WHERE clause, would you?) - use Items.Find/FindNext or Items.Restrict:
set query = "#SQL=(""http://schemas.microsoft.com/mapi/proptag/0x10810003"" = 102) or (""http://schemas.microsoft.com/mapi/proptag/0x10810003"" = 104)"
set olItems = olLookUpFolder.Items.Restrict(query)
for i = olItems.Count to 1 step -1
set olObj = olItems.Item(i)
...
Im trying to look through 2 different boxes(inbox & Outbox), compare the subject and delete the message in the outbox when a match is found. What am I doing incorrectly? Do I need to create another Folder object for each box? EDIT Im getting a "runtime error 13; type mismatch"
Sub DEID()
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Set objNS = GetNamespace("MAPI")
Set objFolder = objNS.Folders.GetFirst
Set objIFolder = objFolder.Folders("Inbox")
Set objOFolder = objFolder.Folders("Outbox")
Dim Item, OItem As Outlook.MailItem
For Each Item In objIFolder.Items
Set ISub = Right(CStr(Item.Subject), Len(Item.Subject) - 6)
Set ISub = CStr(ISub)
For Each OItem In objOFolder.Items
Set OSub = Right(CStr(OItem.Subject), Len(OItem.Subject) - 6)
Set ISub = CStr(OSub)
If StrComp(ISub = OSub, 1) = 0 Then
OItem.Delete
End If
Next OItem
Next Item
End Sub
One thing that jumps out at me is you are using a set command on a value type (subject, which is a string), which you don't need and should cause an error.
Dim Item, OItem As Outlook.MailItem
Dim ISub, OSub As String
For Each Item In objIFolder.Items
ISub = Right(CStr(Item.Subject), Len(Item.Subject) - 6)
ISub = CStr(ISub)
For Each OItem In objOFolder.Items
OSub = Right(CStr(OItem.Subject), Len(OItem.Subject) - 6)
ISub = CStr(OSub)
If StrComp(ISub = OSub, 1) = 0 Then
OItem.Delete
End If
Next OItem
Next Item
One other observation... This line:
ISub = CStr(OSub)
Seems to me like it will force the next condition to always be true. Unless I misunderstand, that seems like a mistake.
I also think the String conversion are unnecessary since subject is already a string.
This would be my final version:
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Set objNS = GetNamespace("MAPI")
Set objFolder = objNS.Folders.GetFirst
Set objIFolder = objFolder.Folders("Inbox")
Set objOFolder = objFolder.Folders("Outbox")
Dim Item, OItem As Outlook.MailItem
Dim ISub, OSub As String
For Each Item In objIFolder.Items
ISub = Right(Item.Subject, Len(Item.Subject) - 6)
For Each OItem In objOFolder.Items
OSub = Right(OItem.Subject, Len(OItem.Subject) - 6)
If ISub = OSub Then
OItem.Delete
End If
Next OItem
Next Item
Firstly, you are dimming Item and OItem as Outlook.MailItem - you can have other items in the Inbox folder (hence the Type Mismatch error), such as ReportItem or MeetingItem. Dim these variables as a generic Object.
Secondly, you are deleting items in a collection while you are looping through it. Do not do that - use a down loop (for i = Items.Count to 1 step -1).
Thirdly, do not loop through all items in a folder - this is hugely inefficient, let Outlook do the job - for the inner use Items.Find / FindNext or Items.Restrict with a query like #SQL="http://schemas.microsoft.com/mapi/proptag/0x0E1D001F" like '%some value%'.
For the outer loop, again, dd not loop, retrieve all subjects in a single call using MAPIFolder.GetTable() / Table.Columns.Add / Table.GetArray / etc. - see https://learn.microsoft.com/en-us/dotnet/api/microsoft.office.interop.outlook.table?view=outlook-pia
This is essentially what I am trying to do...
search for a specific email by subject name
get the attachment to that email ( the attachment is an excel sheet of raw data)
run a formatting subroutine from another module on the excel attachment
place the newly formatted attachment to the body of a new email
Send the new email out to the client
I need help with steps 3 & 4.
Option Explicit
Sub sendEmail()
Dim olApp As Outlook.Application
Dim olEmail As Outlook.MailItem
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMi As MailItem
Dim olAtt As Attachment
Dim MyPath As String
Dim i As Long
Set olApp = New Outlook.Application
Set olEmail = olApp.CreateItem(olMailItem)
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
MyPath = "C:\Users\(Me)\Desktop\"
For i = Fldr.Items.count To 1 Step -1
Set olMi = Fldr.Items(i)
If InStr(1, olMi.Subject, "[The email I'm looking for by subject]") > 0 Then
For Each olAtt In olMi.Attachments
olAtt.Module2.Format '<--- this is where i try to do step 3
olAtt.SaveAsFile MyPath & "NewSheet" & ".xls"
With olEmail
.BodyFormat = olFormatHTML
.Body = olAtt.Range '<----this is where i try to do step 4
.To = "someone#something.com"
.Subject = "Tester"
.send
End With
Next olAtt
olMi.Save
End If
Next i
Set olAtt = Nothing
Set olMi = Nothing
Set Fldr = Nothing
Set MoveToFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub
See Getting Started with VBA in Outlook 2010.
I have noticed the following code:
For i = Fldr.Items.count To 1 Step -1
Set olMi = Fldr.Items(i)
If InStr(1, olMi.Subject, "[The email I'm looking for by subject]") > 0 Then
Do not iterate over all items in the folder. Instead, you need to use the Find/FindNext or Restrict methods of the Items class to get items which corresponds to your conditions. You can read more about them in the following articles in MSDN. Also you may find the following articles helpful:
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
.Body = olAtt.Range '<----this is where i try to do step 4
The Outlook object model provides three main ways for working with item bodies:
Body.
HTMLBody.
The Word editor. The WordEditor property of the Inspector class returns an instance of the Word Document which represents the message body. So, you can use the Word object model do whatever you need with the message body.
See Chapter 17: Working with Item Bodies for more information.
I am trying to delete all appointments from an Excel VBA (Excel 2010) macro.
I get an Error 13 (Type Mismatch) on olFolder.Items.GetFirst.
It ran a few weeks ago.
Sub DeleteAllAppointments()
Dim olApp As Object
Application.ScreenUpdating = False
Set olApp = CreateObject("Outlook.Application")
Dim olApptItem As Outlook.AppointmentItem
Dim olMeetingItem As Outlook.MeetingItem
Dim olNameSpace As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olObject As Object
Dim olItems As Items
Dim i As Double
Set olNameSpace = olApp.GetNamespace("MAPI")
Set olFolder = olNameSpace.GetDefaultFolder(olFolderCalendar)
Set olItems = olFolder.Items
Set olApptItem = olFolder.Items.GetFirst
For i = 1 To olItems.Count
If olItems.Count > 1 Then
olApptItem.Delete
Set olApptItem = olFolder.Items.GetNext
Else
Set olApptItem = olFolder.Items.GetLast
olApptItem.Delete
End If
Next
End Sub
As already mentioned you should delete them in reverse order - as they are re-indexed each time and you eventually try to refer to an item that doesn't exist.
You don't need to Set the next item in the loop as you can use Remove(i) to delete a particular item:
For i = olItems.Count To 1 Step -1
If TypeOf olItems(i) Is olApp.AppointmentItem Then
olItems.Remove (i)
End If
Next i
However, this code will delete EVERY appointment, because practically everything within the calendar is an AppointmentItem. If you don't want to delete, for example, a Meeting then you need to read some property such as MeetingStatus, which is 1 for a Meeting and 0 for a Non-Meeting:
For i = olItems.Count To 1 Step -1
If TypeOf olItems(i) Is olApp.AppointmentItem Then
If olItems(i).MeetingStatus = 0 Then
olItems.Remove (i)
End If
End If
Next i
From Excel though, using olAppointment may be preferable to AppointmentItem because you can substitute the numeric value of 26 if necessary: If olItems(i).Class = 26.
Usually that means that you actually have some items in your folder that are not an Appointment item. You need to test what the item is before assuming that it is an appointment. This is true even when the folder is set to only contain appointment items.
Dim myItem As Object
Dim olfolder As Outlook.folder
Dim apptItem As AppointmentItem
Set olfolder = Application.Session.GetDefaultFolder(olFolderCalendar)
For i = olfolder.Items.Count To 1 Step -1
Set myItem = olfolder.Items(i)
If myItem.Class = olAppointment Then
Set apptItem = myItem
'code here
End If
Next
When deleting items it's usually best to start high and iterate backwards. Delete as you go.
I know the request is a bit old, but I wanted to contribute with a code I have written which may help.
Sub CalendarCleanup()
Dim tmpCalendarFolder As Outlook.MAPIFolder
Dim i As Long
Set tmpCalendarFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar)
' If you want to target a specific folder, you can use this code
'Set tmpCalendarFolder = Application.GetNamespace("MAPI").Folders("YOUR INBOX NAME").Folders("YOUR CALENDAR FOLDER")
'For i = 1 to tmpCalendarFolder.Items.Count Step -1
For i = tmpCalendarFolder.Items.Count to 1 Step -1
tmpCalendarFolder.Items(i).Delete
Next i
End Sub
Please make sure the correct folder is selected (tmpCalendarFolder) before running the code... or at least make some tests before running on a "production" environment, as you are deleting items.
EDIT: code adjusted as per comments below
I'm looking to set a Date on a field anytime an email is moved into a specific folder.
the field is custom called "Completed Date".
Could I get a little help on VBA code to set a custom field (date) when an item is moved into a folder (folder name is "Completed").
I'm ultimately looking to report on the time an item (custom form email) was received to the time it was completed (as per the action of moving the email to a completed folder.
Very rudimentary ticketing system, I'm very aware :) .
thanks,
A
Use ItemAdd http://www.outlookcode.com/article.aspx?id=62 where you reference the "Completed" folder.
Combine it with code like this http://www.vbaexpress.com/forum/showthread.php?5738-Need-to-Add-a-Userdefined-Property-to-Mail-Items
SAMPLE CODE
Change it so you do not update all items in the folder just the one item that triggered ItemAdd.
Option Explicit
Sub AddAUserDefinedProperty()
Dim olApplication As Outlook.Application
Dim olNameSpace As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim olItem As Object
Dim strDomain As String
Dim olProperty As Outlook.UserProperty
Set olApplication = New Outlook.Application
Set olNameSpace = olApplication.GetNamespace("Mapi")
Set olFolder = olNameSpace.GetDefaultFolder(olFolderJunk)
For Each olItem In olFolder.Items
strDomain = Mid(olItem.SenderEmailAddress, _
InStr(1, olItem.SenderEmailAddress, "#") + 1)
Set olProperty = olItem.UserProperties.Add("Domain", olText)
olProperty.Value = strDomain
Debug.Print olItem.SenderEmailAddress, olProperty.Value
olItem.Save
Next olItem
Set olApplication = Nothing
Set olNameSpace = Nothing
Set olFolder = Nothing
Set olProperty = Nothing
End Sub
Even more reference material here http://www.codeproject.com/Articles/427913/Using-User-Defined-Fields-in-Outlook