Access VBA code to import emails into table [closed] - vba

Question

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 4 months ago.
Improve this question
I have inherited a database which has VBA code, unfortunately the colleague has left the organisation and we need to make 4 amendments. 1 - The code works on your personal inbox however we have moved to a team mailbox, so can anyone assist with how to change the code to address this? 2 - We need to pull the senders email address currently it pulls the persons name on occasion it will identify an email but that is very limited (is it to do with the SMTP address?) 3 - we would like to put a date range for the pulling of emails. 4- Once it has imported the emails can it move them to a folder called imported.
Thanks
Sub ImportMailPropFromOutlook()
' Code for specifing top level folder and initializing routine.
' Set up Outlook objects.
Dim ol As New Outlook.Application
Dim olns As Outlook.Namespace
Dim ofO As Outlook.MAPIFolder
Dim ofSubO As Outlook.MAPIFolder
Dim objItems As Outlook.Items
Set olns = ol.GetNamespace("MAPI")
Set ofO = olns.GetDefaultFolder(olFolderInbox) '--- Specifies top level folder for importing Oultook mail.
'Set of = olns.PickFolder '--- Allows user to select top level folder for importing Outlook mail.
'Set info and call GetMailProp code.
Set objItems = ofO.Items
GetMailProp objItems, ofO
'Set info and call ProcessSubFolders.
'For Each ofSubO In of.Folders
' Set objItems = ofSubO.Items
' ProcessSubFolders objItems, ofSubO
'Next
End Sub
Sub GetMailProp(objProp As Outlook.Items, ofProp As Outlook.MAPIFolder)
' Code for writeing Outlook mail properties to Access.
' Set up DAO objects (uses existing Access "Email" table).
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("Email")
'Set Up Outlook objects.
Dim cMail As Outlook.MailItem
Dim cAtch As Outlook.Attachments
'Write Outlook mail properties to Access "Email" table.
iNumMessages = objProp.Count
If iNumMessages <> 0 Then
For i = 1 To iNumMessages
If TypeName(objProp(i)) = "MailItem" Then
Set cMail = objProp(i)
'If ([rst]![EmailLocation] <> ofProp.Name) And ([rst]![EntryID] <> cMail.EntryID) Then
rst.AddNew
rst!EntryID = cMail.EntryID
rst!ConversationID = cMail.ConversationID
rst!Sender = cMail.Sender
rst!SenderName = cMail.SenderName
rst!SentOn = cMail.SentOn
rst!To = cMail.To
rst!CC = cMail.CC
rst!BCC = cMail.BCC
rst!Subject = cMail.Subject
Set cAtch = cMail.Attachments
cntAtch = cAtch.Count
If cntAtch > 0 Then
For j = cntAtch To 1 Step -1
strAtch = cAtch.Item(j).FileName
rst!Attachments = strAtch
Next
Else
rst!Attachments = "No Attachments"
End If
'rst!Count = cMail.Attachments.Count
rst!Body = cMail.Body
rst!HTMLBody = cMail.HTMLBody
rst!Importance = cMail.Importance
rst!Size = cMail.Size
rst!CreationTime = cMail.CreationTime
rst!ReceivedTime = cMail.ReceivedTime
rst!ExpiryTime = cMail.ExpiryTime
'rst!EmailLocation = ofProp.Name
rst.Update
'End If
End If
Next i
End If
End Sub
Sub ProcessSubFolders(objItemsR As Outlook.Items, OfR As Outlook.MAPIFolder)
'Code for processing subfolders
' Set up Outlook objects.
Dim ofSubR As Outlook.MAPIFolder
'Set info and call GetMailProp code.
GetMailProp objItemsR, OfR
'Set info and call ProcessSubFolders. Recursive.
For Each ofSubR In OfR.Folders
Set objItemsR = ofSubR.Items
ProcessSubFolders objItemsR, ofSubR
Next
End Sub

Answer 1

We need to pull the senders email address currently it pulls the persons name on occasion it will identify an email but that is very limited (is it to do with the SMTP address?)
In the code you are getting the Sender property, but it is not a scalar property. it returns an instance of the an AddressEntry object that corresponds to the user of the account from which the MailItem is sent. Instead, you need to use the Address property of the AddressEntry class to get a string representing the email address.
In case of Exchange accounts you may use the AddressEntry.GetExchangeUser method which returns an ExchangeUser object that represents the AddressEntry if the AddressEntry belongs to an Exchange AddressList object such as the Global Address List (GAL) and corresponds to an Exchange user. Then you may get the ExchangeUser.PrimarySmtpAddress property value which is a string representing the primary Simple Mail Transfer Protocol (SMTP) address for the ExchangeUser. Returns an empty string if this property has not been implemented or does not exist for the ExchangeUser object.
In cases when you need to convert Ex-like addresses to SMTP ones you may find the HowTo: Convert Exchange-based email address into SMTP email address article helpful.
Once it has imported the emails can it move them to a folder called imported.
Use the Move method available for all Outlook items.