Clash Royale CLAN TAG#URR8PPP

Finding Outlook Email Address of mailitem via SQL/VBA with Access

Using Access/VBA/SQL to get various email properties from the inbox as I transfer it into a new table "MyInbox".

Sub InboxImport()
Dim SqlString As String
Dim ConnectionString As String
Dim EmailTableName As String
Dim UserIdNum As String
Dim EmailAddr As String
Dim olNS As Outlook.NameSpace
Dim olFol As Outlook.Folder

Set ol = CreateObject("Outlook.Application")
Set olNS = ol.GetNamespace("MAPI")
Set olFol = olNS.GetDefaultFolder(olFolderInbox)

EmailTableName = "MyInbox"
UserIdNum = Environ("USERNAME") '1277523A...
EmailAddr = olFol.Parent.Name 'Gives your user email address
ConnectionString = "Outlook 9.0;MAPILEVEL=" & EmailAddr & "|;PROFILE=Default Outlook Profile;TABLETYPE=0;TABLENAME=MyInbox;COLSETVERSION=12.0;DATABASE=C:Users" & UserIdNum & "AppDataLocalTemp"

SqlString = "SELECT [From] As [Sender], [Email] As [Email Addy], [Subject Prefix] & [Normalized Subject] As Subject, [Contents] As [Body], [Received] As [ReceivedTime]" & _
" INTO [MyInbox]" & _
" From [" & ConnectionString & "].[Inbox]"

DoCmd.SetWarnings False
DoCmd.RunSQL SqlString
DoCmd.SetWarnings True
End Sub


I'm trying to find the "Sender Email" address for every email item in the inbox. As run, it currently pops up with a "Enter Parameter..." with a blank value for [Email].

Is there a good compiled reference for looking up all these different kinds of email SQL terms?

1 Answer
1

Loop through email items. Unfortunately, the INSERT sql has issue with embedded special characters in the email body, apparently related to hyperlinks. I didn't think it worthwhile figuring out how to get around it.

Public Sub ImportEmails()

' Set up Outlook objects.
Dim ol As New Outlook.Application
Dim of As Outlook.MAPIFolder
Dim objItems As Outlook.Items
Dim mo As Outlook.MailItem, Atmt As Outlook.Attachment
'Set of = ol.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox).Folders("Repairs")
Set of = ol.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
Set objItems = of.Items

Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("MyInbox")

For Each mo In objItems

'CurrentDb.Execute "INSERT INTO MyInbox SELECT '" & mo.SenderEmailAddress & "' AS Sender, '" & _
mo.SenderName & "' AS SenderName, '" & mo.Subject & "' AS Subject, '" & _
mo.body & "' AS Body, #" & mo.ReceivedTime & "# AS Received"

rst.AddNew
rst!EmailAdd = mo.SenderEmailAddress
rst!SenderName = mo.Sender
rst!Subject = mo.Subject
rst!body = mo.body
rst!Received = mo.ReceivedTime
rst.Update
'For Each Atmt In mo.Attachments
' Atmt.SaveAsFile "C:path" & Atmt.FileName
'Next

Next
End Sub


By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.