sql - 通过带有 Access 的 SQL/VBA 查找 mailitem 的 Outlook 电子邮件地址

Question

当我将其传输到新表“MyInbox”时，使用 Access/VBA/SQL 从收件箱中获取各种电子邮件属性。

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 & "\AppData\Local\Temp\"

    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

我正在尝试为收件箱中的每个电子邮件项目查找“发件人电子邮件”地址。在运行时，它当前会弹出一个“输入参数...”，其中 [Email] 的值为空白。

是否有一个很好的编译参考来查找所有这些不同类型的电子邮件 SQL 术语？

标签： sqlvbams-accessoutlook

Answer 1

循环浏览电子邮件项目。不幸的是，INSERT sql 在电子邮件正文中嵌入了特殊字符，显然与超链接有关。我认为弄清楚如何绕过它是不值得的。

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