With the help of below coding I am able to retrieve the data from outlook inbox and update the same in excel.
The problem is that I am not able to update the latest response as macro read first come first update basis. If I get the response from abc yesterday and updated response from abc today, the macro is updating the yesterday's response. How can we change the code so that macro should read the emails from bottom of folder and the data that is pulled is updated.
In short, I want to update the latest response in my records.
Dim outlookApp As Outlook.Application, oOutlook As Object
Dim oInbox As Outlook.Folder, oMail As Outlook.MailItem
Dim strAddress As String, strEntryId As String, getSmtpMailAddress As String
Dim objAddressentry As Outlook.AddressEntry, objExchangeUser As Outlook.ExchangeUser
Dim objReply As Outlook.MailItem, objRecipient As Outlook.Recipient
Set outlookApp = New Outlook.Application
Set oOutlook = outlookApp.GetNamespace("MAPI")
Set oInbox = oOutlook.GetDefaultFolder(olFolderInbox)
For Each oMail In oInbox.Items
If oMail.SenderEmailType = "SMTP" Then
strAddress = oMail.SenderEmailAddress
Else
Set objReply = oMail.Reply()
Set objRecipient = objReply.Recipients.Item(1)
strEntryId = objRecipient.EntryID
objReply.Close OlInspectorClose.olDiscard
strEntryId = objRecipient.EntryID
Set objAddressentry = oOutlook.GetAddressEntryFromID(strEntryId)
Set objExchangeUser = objAddressentry.GetExchangeUser()
strAddress = objExchangeUser.PrimarySmtpAddress()
End If
getSmtpMailAddress = strAddress
body = oMail.body
Loop backwards:
For i = oInbox.Count To 1 Step -1
If TypeName(oInbox.item(i)) = "MailItem" Then
Set oMail = oInbox.item(i)
'Do stuff here
Set oMail = Nothing
End If
Next i
Related
This question already has an answer here:
Select inboxes in different outlook accounts
(1 answer)
Closed 8 days ago.
I am trying to access a specific mail account in Outlook and going through the Sent Mail to get certain data from the mailbox.
I get a Run-time error ´438´ - Object doesn't support this property or method, when I reach
Set olSent = Account.GetDefaultFolder(olFolderSentMail)
I have used MsgBox Account.DisplayName and it showed me the correct account. I have swapped olFolderSentMail to 5. Always the same error.
Any idea what the issue could be?
Sub CopyEmailBodyToExcel()
Dim OutlookApp As Object
Dim MItem As Object
Dim xlSheet As Object
Dim RowCounter As Integer
Dim olNs As Object
Dim olSent As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set olNs = OutlookApp.GetNamespace("MAPI")
For Each Account In olNs.Accounts
If Account.SMTPAddress = testmymail#company.com Then
MsgBox Account.DisplayName
'Set olSent = Account.Folders("Sent Items")
Set olSent = Account.GetDefaultFolder(olFolderSentMail)
Exit For
End If
Next Account
Set xlSheet = Worksheets("Sheet3")
RowCounter = 1
For Each MItem In olSent
If MItem.Subject = "Payload Notification" Then
xlSheet.Cells(RowCounter, 1).Value = MItem.Body
RowCounter = RowCounter + 1
End If
Next MItem
xlApp.Visible = True
End Sub
In Microsoft Visual Basic, I had to go in Tools > References and add the Microsoft Outlook 16 Library.
I then changed to the following:
Dim olNs As Outlook.Namespace
Dim olSent As Outlook.MAPIFolder
Then I could follow the question the niton referenced to and changed the For Each Loop
For Each Account In olNs.Accounts
If Account.SMTPAddress = testmymail#company.com Then
Set olSent = Account.DeliveryStore.GetDefaultFolder(olFolderSentMail)
Exit For
End If
Next Account
Now it seems to work as promised.
the code below creates a recurring Outlook appointment and another Outlook appointment through Excel and VBA. i'm trying to send the appointment to a different inbox, but i keep getting the "Run-time Error 287: Application-defined or object-defined error" at the line "OutlookAppt.Recipients.Add ("XXXXXX#company-company.com")". the code works, except when i add this line, so i'm wondering why.
please let me know if you have any ideas as to how to fix this.
thank you a bunch in advance!
Sub CompleteReminders()
Dim rows
Dim sDate As Date, newFU As Date, newDate As Date, iDate As Date, generalDate As Date
Dim iValue As Integer
Dim iteration As Integer
Dim LastRow As Long
Dim i As Long
Dim x As Integer
Dim xRg As Range
Dim myNamespace As Object
Dim objfolder As Outlook.Folder
Dim OutlookAppt As Outlook.AppointmentItem
Dim OutlookAppt2 As Outlook.AppointmentItem
Dim myRecurrPatt As Outlook.RecurrencePattern
Const olFolderCalendar = 9
Const olAppointment = 26
Dim n As Integer
Set OutApp = GetObject(, "Outlook.Application")
If ErrL <> 0 Then
Set OutApp = CreateObject("Outlook.Application")
End If
Set myNamespace = OutApp.GetNamespace("MAPI")
Set objfolder = myNamespace.PickFolder 'Sets folder where appt will be created
Set xRg = Range("B6:D6")
Set OutlookAppt = OutApp.CreateItem(1)
OutlookAppt.Duration = 5
Set myRecurrPatt = OutlookAppt.GetRecurrencePattern
With myRecurrPatt
.PatternStartDate = Range("C1").Value
.RecurrenceType = olRecursMonthNth
.Interval = Range("C3").Value
.PatternEndDate = dateEnd
.StartTime = #5:00:00 PM#
.EndTime = #5:05:00 PM#
End With
OutlookAppt.Subject = xRg.Cells(1, 1).Value
If xRg.Cells(1, 2).Value > 0 Then
OutlookAppt.ReminderSet = True
OutlookAppt.ReminderMinutesBeforeStart = xRg.Cells(4, 6).Value
Else
OutlookAppt.ReminderSet = False
End If
OutlookAppt.Body = xRg.Cells(1, 3).Value
OutlookAppt.BusyStatus = olFree
OutlookAppt.Recipients.Add ("XXXXXX#company-company.com")
OutlookAppt.Save
Set OutlookAppt = objfolder.Items.Add(olAppointmentItem)
End Sub
If your code is running unattended, make sure the security prompt is not getting in the way. Make sure antivirus app and its definitions are up-to-date.
Also try to replace the problematic line line with
OutlookAppt.RequiredAttendees = "XXXXXX#company-company.com"
For the RequiredAttendees property, only reading is blocked, but not setting.
In some really quick testing, I was able to get the line to work by setting the object (recipients are objects):
Dim requiredRecipient as Outlook.Recipient
Set requiredRecipient = OutlookAppt.Recipients.Add ("XXXXXX#company-company.com")
requiredRecipient.Type = olRequired
Docs for reference: https://learn.microsoft.com/en-us/office/vba/api/outlook.recipients
Get rid of () when calling Recipients.Add:
OutlookAppt.Recipients.Add "XXXXXX#company-company.com"
or change it to
set Recip = OutlookAppt.Recipients.Add ("XXXXXX#company-company.com")
() in VB are only used when calling a function, but not a sub.
Consider using the AppointmentItem.RequiredAttendees property instead. Also you may find the AppointmentItem.OptionalAttendees property helpful which returns or sets a string representing the display string of optional attendees names for the appointment. This is a semicolon-delimited string of required attendee names for the meeting appointment.
In case of using the Recipients property for meetings you need to use the OlMeetingRecipientType enumeration.
OutlookAppt.Recipients.Add "XXXXXX#company-company.com"
CONTEXT: I'm trying to first check if mails in a folder ("pending") are read. If the mail is read, move it to another folder ("done").
Then, for the remaining mails in "pending", save the attachments and mark the mail as "read".
PROBLEM: When I try to loop through the items in the folder it drops
Run-time error 438:
The object doesn't support this property or method
CODE:
Sub MoveInbox2Reviewed()
Dim OutlookApp As Outlook.Application
Dim ONameSpace As Object
Dim OItem As Outlook.MailItem
Dim OFolderSrc As Object
Dim OFolderDst As Object
Dim Path As String
Set OutlookApp = New Outlook.Application
Set ONameSpace = OutlookApp.GetNamespace("MAPI")
Set OFolderSrc = ONameSpace.GetDefaultFolder(olFolderInbox).Folders("pending")
Set OFolderDst = ONameSpace.GetDefaultFolder(olFolderInbox).Folders("done")
Path = "C:\Users\..."
For Each OItem In OFolderSrc
If OItem.UnRead = False Then
OItem.Move OFolderDst
End If
Next
For Each OItem In OFolderSrc
OItem.Attachments.SaveAsFile Path & Attachment.DisplayName
OItem.UnRead = False
Next
End Sub
Firstly, you are looping through the folders. not items. You need OFolderSrc.Items.
Secondly, you should never loop through all items in a folder, use Items.Restrict:
For Each OItem In OFolderSrc.Items.Restrict("[Unread] = true")
I have a userform with 3 textboxes and 1 button. I want to put an outlook alias into textbox1 (txtPID) and return the display type and email in boxes 2 & 3 (txtName & txtEmail)
this appears to connect to outlook and pull information but it's not searching the alias given in textbox 1
Load UsrFrmNewRep
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olGAL As Outlook.AddressList
Dim olMember As Outlook.AddressEntry
Dim olAliasName As String
Dim exchuser As Outlook.ExchangeUser
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
Set olGAL = olNS.AddressLists("Global Address List")
olAliasName = UsrFrmNewRep.txtPID.Value
Set olMember = olGAL.AddressEntries(olAliasName)
Set exchuser = olMember.GetExchangeUser
If Not exchuser Is Nothing Then
UsrFrmNewRep.txtName.Value = exchuser.DisplayType
UsrFrmNewRep.txtEmail.Value = exchuser.PrimarySmtpAddress
End If
End Sub
i'm sure i'm not referencing something correctly i'm just not sure what.
Thanks
Instead of using olGAL.AddressEntries(olAliasName), use olNS.CreateRecipient(olAliasName) / Recipient.Resolve / set olMember = Recipient.AddressEntry
My company is transferring from Outlook 16 to Outlook 365, and the Excel VBA script below now needs to refer to a mailbox in Outlook 365.
It errors on the line
Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail).Folders("inbox")
with the error
The attempted operation failed. An object could not be found.
Is it possible the mailbox needs to be added in a different way? Or is there a different way to do this function in Outlook 365?
I am not seeing much on a different way to do this with Outlook 365.
Sub Import_Email_Preferences()
Const strMail As String = "borrowerservicesshiftbid#glhec.org"
Dim oApp As Outlook.Application
Dim oMapi As Outlook.MAPIFolder
Dim oMail As Outlook.MailItem
Dim strEmailAddress As String
Dim strSenderName As String
Dim strSubject As String
Dim intRow As Integer
Dim i As Long
Dim tbl As ListObject
Dim ltblRow As Long
Set tbl = ThisWorkbook.Worksheets("Preferences").ListObjects(1)
ltblRow = tbl.DataBodyRange.Rows.Count
On Error Resume Next
Set oApp = GetObject(, "OUTLOOK.APPLICATION")
If (oApp Is Nothing) Then Set oApp = CreateObject("OUTLOOK.APPLICATION")
On Error GoTo 0
'Getting Error Here
Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail).Folders("inbox")
For i = oMapi.Items.Count To 1 Step -1
Set oMail = oMapi.Items(i)
If TypeOf oMail Is Outlook.MailItem Then
MsgBox = "Blue"
End If
Next i
Set oApp = Nothing
Set oMapi = Nothing
Set oMail = Nothing
Set oHTML = Nothing
Set oElColl = Nothing
End Sub
Please try to reference the inbox by GetDefaultFolder:
On Error Resume Next
If oApp Is Nothing Then
Set oApp = GetObject(, "Outlook.Application")
If oApp Is Nothing Then
Set oApp = New Outlook.Application
End If
End If
On Error GoTo 0
Set oMapi = oApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
If the default folder ist not accessible, be aware that folder names are language dependent, e. g. Namespace.Folders("Posteingang") in German.
The trouble with Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail).Folders("inbox") is you are stringing references together. This is fine if it works but you do not know what has failed if it does not.
Set oMapi = oApp.GetNamespace("MAPI") will fail if oApp is not an object.
Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail) will fail if oApp.GetNamespace("MAPI") is not an object.
Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail).Folders("inbox") will fail if oApp.GetNamespace("MAPI").Folders(strMail) is not an object.
I suggest trying the subroutine below to identify which step is failing. This subroutine does everything in single steps. It also tries different ways of achieving the same effect. If one Set fails, comment it out and see if the next one works.
I have suggested some possible causes of failures but I am sure there are other possibilities. Once you know the step that fails, come back if you need further help.
You may wish to try Asger suggestion of GetDefaultFolder as well. It does not work on my system because the default Inbox in not used. I have to name the store containing the Inbox I wish to access.
Sub TestGetInbox()
Dim olApp As Outlook.Application
Dim olInbox1 As Outlook.MAPIFolder
Dim olInbox2 As Outlook.Folder
Dim olInbox3 As Outlook.MAPIFolder
Dim olInbox4 As Outlook.Folder
Dim olNs As Outlook.Namespace
Dim olSession As Outlook.Namespace
Dim olStore1 As Outlook.Folder
Dim olStore2 As Outlook.Folder
' If execution stops her, you have a problem accessing Outlook
Set olApp = CreateObject("Outlook.Application")
' If execution stops here, you have a problem accessing Outlook's namespace
' using this method. Comment out statements down to "Set olSession = olApp.Session"
Set olNs = olApp.GetNamespace("MAPI")
' If execution stops here, look at your folder pane. Is "borrowerservicesshiftbid#glhec.org"
' the name of a store? Case does not seem to matter but a single letter change in the name
' does.
Set olStore1 = olNs.Folders("borrowerservicesshiftbid#glhec.org")
Debug.Print olStore1.Name
Set olInbox1 = olStore1.Folders("Inbox")
Debug.Print olInbox1.Name
Set olInbox2 = olStore1.Folders("Inbox")
Debug.Print olInbox1.Name
' If execution stops her, you have a problem accessing Outlook's namespace
' This is a different methods of accessing Outlook's namespace. The documentation
' says the two method are identical but I once had the olApp.Namespace("MAPI")
' fail so I now always use the olApp.Session method which has never failed for me.
Set olSession = olApp.Session
Set olStore2 = olSession.Folders("borrowerservicesshiftbid#glhec.org")
Debug.Print olStore2.Name
Set olInbox3 = olStore1.Folders("Inbox")
Debug.Print olInbox1.Name
Set olInbox4 = olStore1.Folders("Inbox")
Debug.Print olInbox1.Name
Set olInbox1 = Nothing
Set olInbox2 = Nothing
Set olStore1 = Nothing
Set olNs = Nothing
Set olInbox3 = Nothing
Set olInbox4 = Nothing
Set olStore2 = Nothing
Set olSession = Nothing
Set olApp = Nothing
End Sub