Сохранить вложение Outlook в MS Access с помощью VBA

Question

Я запускаю MS Access 2010. Используя VBA, я пытаюсь вытащить вложения из MS Exchange 2013 и вставить их в таблицу Access «TBL_APPT_ATTACHMENT».

В таблице «TBL_APPT_ATTACHMENT» выглядит следующим образом: Attachment_title Memo Attachment_filename Memo Attachment_blob OLE Object

Все кажется работать правильно, за исключением я не могу понять, как сохранить фактический файл в ATTACHMENT_BLOB колонке. Вот моя функция VBA, которую я вызываю (см. Вопросительные знаки ниже).

Private Function createRecord(fItem As Outlook.AppointmentItem) 

    Set rsAtt = CurrentDb.OpenRecordset("TBL_APPT_ATTACHMENT") 
    rsAtt.OpenRecordset 

    For Each Attachment In fItem.Attachments 
    Call MsgBox("FileName: " & Attachment.FileName, vbOKOnly, "Error") 
    Call MsgBox("DisplayName: " & Attachment.DisplayName, vbOKOnly, "Error") 
    Call MsgBox("Index: " & Attachment.Index, vbOKOnly, "Error") 

    rsAtt.AddNew 
    rsAtt!APPT_ITEM_ID = aID 
    rsAtt!APPT_FIELD_id = rsOl!ID 
    rsAtt!ATTACHMENT_TITLE = Attachment.DisplayName 
    rsAtt!ATTACHMENT_FILENAME = Attachment.FileName 
    rsAttID = rsAtt!ID 
    rsAtt.Update 

    'Save file to harddrive. 
    filePath = "c:\temp\" + Attachment.FileName 
    Attachment.SaveAsFile (filePath) 

    Set rsParent = CurrentDb.OpenRecordset("SELECT ID, ATTACHMENT_BLOB FROM TBL_APPT_ATTACHMENT WHERE ID = " & rsAttID) 
    rsParent.OpenRecordset 
    Do While Not rsParent.EOF 
     rsParent.Edit 

     'Load file into Database. 

'??? This next statement gives me a "Type Mismatch" error. Why????? 
     Set rsChild = rsParent.Fields("ATTACHMENT_BLOB").Value 

     rsChild.AddNew 
     rsChild.Fields("FileData").LoadFromFile (filePath) 
     rsChild.Update 
     rsParent.Update 
     rsParent.MoveNext 
    Loop 
    Next 
End Function 

Спасибо!

Answer 1

Помните, что вложение - это действительно файл (независимо от того, является ли его объектом OLE или нет). Хотя это может быть возможно выполнить копировать-вставить объект из Outlook, в Access, моя рекомендация состоит в том, чтобы сохранить вложение в виде файла:

dim filepath as String 
dim filename as String 
filepath = "C:\appropriatefolder\" 
filename = Attachment.FileName 
Attachment.SaveAsFile filepath & filename 

Теперь вы находитесь в положении, чтобы сохранить вложение в Access , но я серьезно не рекомендую использовать тип поля Attachment. Это может быть довольно сложно использовать. Поэтому мое решение этой же задачи состояло в создании поля типа Hyperlink. Тогда ваше заявление в макросе будет просто:

rsAtt!ATTACHMENT_LINK = filename & "#" & filepath & filename 

Определение гиперссылки важно и использует формат:

displayString # fullPathToFile [ # optionalPositionInsideFile ] 

EDIT: Using the Attachment Field Type in Access

Тип Attachment поля в таблице Access можно понять, если рассмотрите его как встроенный recordset в пределах одной записи. Поэтому каждый раз, когда вы добавляете новую запись (или читаете существующую запись), вы должны обрабатывать поле Attachment несколько иначе. Фактически, поле .Value поля Attachment является самим recordset.

Option Compare Database 
Option Explicit 

Sub test() 
    AddAttachment "C:\Temp\DepTree.txt" 
End Sub 

Sub AddAttachment(filename As String) 
    Dim tblAppointments As DAO.Recordset 
    Dim attachmentField As DAO.Recordset 
    Dim tblField As Field 

    Set tblAppointments = CurrentDb.OpenRecordset("TBL_APPT_ATTACHMENT", dbOpenDynaset) 

    tblAppointments.AddNew 
    tblAppointments![APPT_ITEM_ID] = "new item id" 
    tblAppointments![APPT_FIELD_ID] = "new field id" 
    tblAppointments![ATTACHMENT_TITLE] = "new attachment" 
    tblAppointments![ATTACHMENT_FILENAME] = filename 

    '--- the attachment field itself is a recordset, because you can add multiple 
    ' attachments to this single record. so connect to the recordset using the 
    ' .Value of the parent record field, then use it like a recordset 
    Set attachmentField = tblAppointments![ATTACHMENT_BLOB].Value 
    attachmentField.AddNew 
    attachmentField.Fields("FileData").LoadFromFile filename 
    attachmentField.Update 

    tblAppointments.Update 

    tblAppointments.Close 
    Set tblAppointments = Nothing 
End Sub 

Answer 2

Вот что я в итоге сделал.