Hi team,
I am downloading emails from outlook to ms access using below given codes. Timer function will activate these codes and download mails. But i heard there is a way to directly download the mails from exchange server instead of relying on outlook. Since database will be more stable if data is directly getting downloaded from server rather than relying on timer function. I tried for several days still I coul not find a solution. Could you assist me in modifying below given code so that I can download mails directly from server.
I am downloading emails from outlook to ms access using below given codes. Timer function will activate these codes and download mails. But i heard there is a way to directly download the mails from exchange server instead of relying on outlook. Since database will be more stable if data is directly getting downloaded from server rather than relying on timer function. I tried for several days still I coul not find a solution. Could you assist me in modifying below given code so that I can download mails directly from server.
Code:
Private Sub getml()
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
Set db = CurrentDb
Set OlApp = CreateObject("Outlook.Application")
Set inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFold erInbox)
Set rst= CurrentDb.OpenRecordset("mls")
Set inboxItems = inbox.Items
For Each Mailobject In inboxItems
With rst
.AddNew
!task= Mailobject.UserProperties.Find("taskID")
!estml= Mailobject.UserProperties.Find("estimate")
.Update
Mailobject.UnRead = False
End With
End If
Next
Set OlApp = Nothing
Set inbox = Nothing
Set inboxItems = Nothing
Set Mailobject = Nothing
End Sub
Code:
Private Sub sntml()
Dim rst As DAO.Recordset
Dim OlApp As Outlook.Application
Dim stfldr As Outlook.MAPIFolder
Dim stfldrItems As Outlook.Items
Dim Mailobject As Object
Dim db As DAO.Database
Dim dealer As Integer
Dim emailCount as integer
Set db = CurrentDb
Set OlApp = CreateObject("Outlook.Application")
Set stfldr = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderSentMail)
Set rst= CurrentDb.OpenRecordset("ogmls")
Set stfldrItems = stfldr.Items
stfldrItems.Sort "[ReceivedTime]"
emailCount=1
For Each Mailobject In stfldrItems
With rst
.AddNew
!Subject = Mailobject.Subject
!from = Mailobject.SenderName
!To = Mailobject.To
!Body = Mailobject.Body
!DateSent = Mailobject.SentOn
.Update
Mailobject.UnRead = False
End With
emailCount = emailCount+1
if emailCount > 10 then
Exit For
end if
Next
Set OlApp = Nothing
Set stfldr = Nothing
Set stfldrItems = Nothing
Set Mailobject = Nothing
Set rst = Nothing
End Sub