I
ID10Terror
A few months ago, I found some code that was really helpful in
reading/importing Outlook 2003 emails (subject & body) into Access 2003. I
am not using "Redemption" because I could not find could code to do what I
needed. Now, for some strage reason, the enclosed code is not working. I
do not know whether this is because of updates or something, but it just
locks up and freezes. Can anyone please help me with this.
TIA
MS Access 2003 Code:
********************************************************************************
Private Sub Command3_Click()
'
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
'
Set Rst = CurrentDb.OpenRecordset("tblMyTable")
Set Olapp = CreateObject("Outlook.Application")
Set Olmapi = Olapp.GetNamespace("MAPI")
Set Olfolder = Olmapi.GetDefaultFolder(olFolderInbox)
Set OlItems = Olfolder.Items
Set OlAccept = Olfolder.Folders("Passed")
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
'
Set OlItems = Olfolder.Items
For Each OlMail In OlItems
'
If OlMail.UnRead = True Then
OlMail.UnRead = False 'Mark mail as read
Rst.AddNew
Rst!ORDERUser = OlMail.SenderName
'
If InStr(1, OlMail.Subject, "ORDER") > 0 Then
Rst!ORDERSubject = OlMail.Subject
Rst!ORDERTime = OlMail.ReceivedTime
Rst!ORDERDate = OlMail.ReceivedTime
Rst!ORDERBody = OlMail.Body
Rst!ORDERHold = "True"
OlMail.Move OlAccept
Else
Rst!ORDERSubject = OlMail.Subject
Rst!ORDERTime = OlMail.ReceivedTime
Rst!ORDERDate = OlMail.ReceivedTime
Rst!ORDERBody = OlMail.Body
Rst!ORDERHold = "False"
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 tbl_temp for details", vbOKOnly
'
End Sub
reading/importing Outlook 2003 emails (subject & body) into Access 2003. I
am not using "Redemption" because I could not find could code to do what I
needed. Now, for some strage reason, the enclosed code is not working. I
do not know whether this is because of updates or something, but it just
locks up and freezes. Can anyone please help me with this.
TIA
MS Access 2003 Code:
********************************************************************************
Private Sub Command3_Click()
'
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
'
Set Rst = CurrentDb.OpenRecordset("tblMyTable")
Set Olapp = CreateObject("Outlook.Application")
Set Olmapi = Olapp.GetNamespace("MAPI")
Set Olfolder = Olmapi.GetDefaultFolder(olFolderInbox)
Set OlItems = Olfolder.Items
Set OlAccept = Olfolder.Folders("Passed")
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
'
Set OlItems = Olfolder.Items
For Each OlMail In OlItems
'
If OlMail.UnRead = True Then
OlMail.UnRead = False 'Mark mail as read
Rst.AddNew
Rst!ORDERUser = OlMail.SenderName
'
If InStr(1, OlMail.Subject, "ORDER") > 0 Then
Rst!ORDERSubject = OlMail.Subject
Rst!ORDERTime = OlMail.ReceivedTime
Rst!ORDERDate = OlMail.ReceivedTime
Rst!ORDERBody = OlMail.Body
Rst!ORDERHold = "True"
OlMail.Move OlAccept
Else
Rst!ORDERSubject = OlMail.Subject
Rst!ORDERTime = OlMail.ReceivedTime
Rst!ORDERDate = OlMail.ReceivedTime
Rst!ORDERBody = OlMail.Body
Rst!ORDERHold = "False"
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 tbl_temp for details", vbOKOnly
'
End Sub