Hi all,
I tried a few versions of exporting emails to a folder and store them in access as well. the separate versions work, but I have no clue how to combine them.
here is the code that I use from outlook:
Code:
Public Sub Command24_Click()
Dim olItem As Outlook.MailItem
Dim fName As String
Dim fPath As String
fPath = "C:t\EmailBackup\"
For Each olItem In ActiveExplorer.Selection
fName = Format(olItem.ReceivedTime, "yyyy_mm_dd -") & Chr(32) & _
Format(olItem.ReceivedTime, "HH.MM") & Chr(32) & _
olItem.SenderName & " - " & olItem.Subject & ".msg"
fName = Replace(fName, Chr(58) & Chr(41), "")
fName = Replace(fName, Chr(58) & Chr(40), "")
fName = Replace(fName, Chr(34), "-")
fName = Replace(fName, Chr(42), "-")
fName = Replace(fName, Chr(47), "-")
fName = Replace(fName, Chr(58), "-")
fName = Replace(fName, Chr(60), "-")
fName = Replace(fName, Chr(62), "-")
fName = Replace(fName, Chr(63), "-")
fName = Replace(fName, Chr(124), "-")
olItem.SaveAs fPath & fName
Next olItem
Set olItem = Nothing
End Sub
This is the code to save the emails to access:
Code:
Option Compare Database
Private Sub Command24_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
Dim fName As String
Dim fPath As String
Dim olItem As Outlook.MailItem
'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
!ReceivedOn = Mailobject.ReceivedOn
!SentOn = Mailobject.SentOn
'!Attachments = Mailobject.Attachments
!SenderEmailAddress = Mailobject.SenderEmailAddress
!CC = Mailobject.CC
.Update
Mailobject.UnRead = False
End With
End If
Next
Set OlApp = Nothing
Set Inbox = Nothing
Set InboxItems = Nothing
Set Mailobject = Nothing
Set TempRst = Nothing
End Sub
Any help getting this solved would be really great.
Greetings.