megatronixs
Registered User.
- Local time
- Today, 17:32
- Joined
- Aug 17, 2012
- Messages
- 719
Hi all,
I found a code that will go trough an emailbox and export all emails to a table in access. This part is working OK (except the received date). I also wante to show in the table if the email contains an attachment, but that part is not working at all.
The project actually is meant to store the emails on a shared drive and attachments and have the emails in Access so I can see them all and recall the one needed.
Thank you in advance.
I found a code that will go trough an emailbox and export all emails to a table in access. This part is working OK (except the received date). I also wante to show in the table if the email contains an attachment, but that part is not working at all.
The project actually is meant to store the emails on a shared drive and attachments and have the emails in Access so I can see them all and recall the one needed.
Code:
Private Sub Command14_Click()
Dim TempRst As DAO.Recordset
Dim rst As DAO.Recordset
Dim OlApp As Outlook.Application
Dim Inbox As Outlook.MAPIFolder
Dim InboxItems As Outlook.Items
Dim Mailobject As Object
Dim db As DAO.Database
Dim dealer As Integer
'DoCmd.RunSQL "Delete * from tbl_outlooktemp"
Set db = CurrentDb
Set OlApp = CreateObject("Outlook.Application")
Set Inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
Set TempRst = CurrentDb.OpenRecordset("tbl_OutlookTemp")
'
Set InboxItems = Inbox.Items
'
For Each Mailobject In InboxItems
If Mailobject.UnRead Then
With TempRst
.AddNew
!Subject = Mailobject.Subject
!SenderName = Mailobject.SenderName
!To = Mailobject.To
!Body = Mailobject.Body
' !Received = Mailobject.Received
!SentOn = Mailobject.SentOn
!Attachments = Mailobject.Attachments
.Update
Mailobject.UnRead = True
End With
End If
Next
Set OlApp = Nothing
Set Inbox = Nothing
Set InboxItems = Nothing
Set Mailobject = Nothing
Set TempRst = Nothing
End Sub
Thank you in advance.