H
Hlewis
I am using the following code to pull emails out of outlook and put them in a
table in Access. The problem I'm having is that I want to pull emails from
an Inbox other than my default Inbox. How do I do that?
Option Compare Database
Option Explicit
Public Sub ImportOutlookItems()
'Define Variables
Dim Olapp As Outlook.Application
Dim Olmapi As Outlook.Namespace
Dim Olfolder As Outlook.MAPIFolder
Dim OlAccept As Outlook.MAPIFolder
Dim OlDecline As Outlook.MAPIFolder
Dim OlFailed As Outlook.MAPIFolder
Dim OlMail As Object 'Have to late bind as appointments e.t.c screw it up
Dim OlItems As Outlook.Items
Dim OlRecips As Outlook.Recipients
Dim OlRecip As Outlook.Recipient
Dim Rst As Recordset
'Open table TLMS_Cost
Set Rst = CurrentDb.OpenRecordset("TLMS_Cost")
'Create a connection to outlook
Set Olapp = CreateObject("Outlook.Application")
Set Olmapi = Olapp.GetNamespace("MAPI")
'Open the inbox
Set Olfolder = Olmapi.GetDefaultFolder(olFolderInbox)
Set OlItems = Olfolder.Items
'Set up the folders the mails are going to be deposited in
'Set OlAccept = Olfolder.Folders("Accept")
'Set OlDecline = Olfolder.Folders("Decline")
'Set OlFailed = Olfolder.Folders("Failed")
'Set up a loop to run till the inbox is empty (otherwise it skips some)
Do Until OlItems.Count = 0
'Reset the Olitems object otherwise new incoming mails and moving mails get
missed
Set OlItems = Olfolder.Items
For Each OlMail In OlItems
'For each email in the collection, check the subject line and process
accordingly
If OlMail.UnRead = True Then
OlMail.UnRead = False 'Keep mail mark as unread
Rst.AddNew
Rst!Date = OlMail.ReceivedTime
Rst!Time = OlMail.ReceivedTime
Rst!From = OlMail.SenderName
'Rst!Name = OlMail.SenderName
Rst!Email = OlMail.EmailAddress
Rst!Description = OlMail.Subject
If InStr(1, OlMail.Subject, "RE: Hey you") > 0 Then
Rst!Status = "Attending"
Rst!datesent = OlMail.ReceivedTime
'OlMail.Move OlAccept
ElseIf InStr(1, OlMail.Subject, "Decline") > 0 Then
Rst!datesent = OlMail.ReceivedTime
Rst!Status = "Decline"
OlMail.Move OlDecline
Else
Rst!datesent = OlMail.ReceivedTime
Rst!Status = "Failed"
'OlMail.Move OlFailed
End If
Rst.Update
End If
Next
Loop
MsgBox "Your wish is my command. New mails have been checked. Please
check the TLMS_Cost for details", vbOKOnly
End Sub
table in Access. The problem I'm having is that I want to pull emails from
an Inbox other than my default Inbox. How do I do that?
Option Compare Database
Option Explicit
Public Sub ImportOutlookItems()
'Define Variables
Dim Olapp As Outlook.Application
Dim Olmapi As Outlook.Namespace
Dim Olfolder As Outlook.MAPIFolder
Dim OlAccept As Outlook.MAPIFolder
Dim OlDecline As Outlook.MAPIFolder
Dim OlFailed As Outlook.MAPIFolder
Dim OlMail As Object 'Have to late bind as appointments e.t.c screw it up
Dim OlItems As Outlook.Items
Dim OlRecips As Outlook.Recipients
Dim OlRecip As Outlook.Recipient
Dim Rst As Recordset
'Open table TLMS_Cost
Set Rst = CurrentDb.OpenRecordset("TLMS_Cost")
'Create a connection to outlook
Set Olapp = CreateObject("Outlook.Application")
Set Olmapi = Olapp.GetNamespace("MAPI")
'Open the inbox
Set Olfolder = Olmapi.GetDefaultFolder(olFolderInbox)
Set OlItems = Olfolder.Items
'Set up the folders the mails are going to be deposited in
'Set OlAccept = Olfolder.Folders("Accept")
'Set OlDecline = Olfolder.Folders("Decline")
'Set OlFailed = Olfolder.Folders("Failed")
'Set up a loop to run till the inbox is empty (otherwise it skips some)
Do Until OlItems.Count = 0
'Reset the Olitems object otherwise new incoming mails and moving mails get
missed
Set OlItems = Olfolder.Items
For Each OlMail In OlItems
'For each email in the collection, check the subject line and process
accordingly
If OlMail.UnRead = True Then
OlMail.UnRead = False 'Keep mail mark as unread
Rst.AddNew
Rst!Date = OlMail.ReceivedTime
Rst!Time = OlMail.ReceivedTime
Rst!From = OlMail.SenderName
'Rst!Name = OlMail.SenderName
Rst!Email = OlMail.EmailAddress
Rst!Description = OlMail.Subject
If InStr(1, OlMail.Subject, "RE: Hey you") > 0 Then
Rst!Status = "Attending"
Rst!datesent = OlMail.ReceivedTime
'OlMail.Move OlAccept
ElseIf InStr(1, OlMail.Subject, "Decline") > 0 Then
Rst!datesent = OlMail.ReceivedTime
Rst!Status = "Decline"
OlMail.Move OlDecline
Else
Rst!datesent = OlMail.ReceivedTime
Rst!Status = "Failed"
'OlMail.Move OlFailed
End If
Rst.Update
End If
Next
Loop
MsgBox "Your wish is my command. New mails have been checked. Please
check the TLMS_Cost for details", vbOKOnly
End Sub