Working with Attachments

Outlook has had attachments for many versions now; Access 2007 introduced the Attachment data type for Access tables. In Outlook, attachments are a collection belonging to various item types, primarily mail messages; Access 2007 attachments are a recordset belonging to a field of the Attachment data type. Because both an Outlook contact item and an Access table may have attachments, I needed to be able to handle copying attachments from an Outlook contact item to an Access table and vice versa.

NEW FEATURE The Attachment field data type is new to Access 2007.

When you add a field of the Attachment data type to an Access 2007 table, it has three subfields, which you can see in the Relationships diagram (see Figure 11.1). The attachment itself is stored in the FileData subfield; its file name and path in the FileName subfield, and the file type in the FileType subfield. Generally, you only need to work with the FileData and FileName subfields when copying Access attachments.

The situation with Outlook attachments is simpler: you just save the attachment file name and path to the Attachments collection of an item, using the Add method of that collection.

Most likely, you will have some attachments, either in your Outlook contacts, or in Access contact records, so my synchronizing code needs to handle attachments. To copy attachments from one place to another, you need to save them to files in a folder; the folder used for this purpose is selected using the Attachments Folder Path button on the main menu, which runs an event procedure that pops up a Folder Picker dialog. The procedures listed next are called from the longer procedures that do the copying of data between the two Access compare tables, as seen on the two contact comparison forms, or between Access and Outlook:

Public Sub CopyAccessAttsToOutlook(con As _

Outlook.Contactltem, rstSourceAttachments As _ DAO.Recordset2) 'Called from UpdateAllOutlookContacts

On Error GoTo ErrorHandler

Set fso = CreateObject("Scripting.FileSystemObject")

With rstSourceAttachments Do While Not .EOF

strDocsPath = GetOutputDocsPath

Need to extract the file name from the FileName field, using the SplitFileName function, because it sometimes contains the path (sometimes multiple times) as well as the file name.

SplitFileName(rstSourceAttachments.Fields("FileName")) Debug.Print "File name: " & strFile strFileAndPath = strDocsPath & strFile Debug.Print "File and path: " & strFileAndPath

On Error Resume Next

Check whether this file already exists in the folder, and save it to the folder if not.

Set fil = fso.GetFile(strFileAndPath) If fil Is Nothing Then

Save this attachment to a file in the Output Docs folder.

.Fields("FileData").SaveToFile strFileAndPath Debug.Print "Saving " & strFileAndPath _ & " to " & strDocsPath & " folder"

End If

Add this attachment to the Attachments collection of the Outlook contact item.

Debug.Print "Adding attachment " & strFileAndPath

& " to " & con.FullName & " contact" con.Save con.Attachments.Add Source:=strFileAndPath, _

Type:=olByValue con.Close (olSave) Kill strFileAndPath .MoveNext Loop rstSourceAttachments.Close End With

ErrorHandlerExit: Exit Sub

ErrorHandler:

& "; Description: " & Err.Description Resume ErrorHandlerExit

End Sub

Public Sub CopyOutlookAttsToAccess(con _

As Outlook.Contactltem, rstTargetAttachments As _ DAO.Recordset2)

'Called from NewAccessContactAndID and 'ImportOutlookContacts

On Error GoTo ErrorHandler

Set fso = CreateObject("Scripting.FileSystemObject")

For Each att In con.Attachments

Extract the file name from the Attachment FileName property. strFile = att.FileName strDocsPath = GetOutputDocsPath strFileAndPath = strDocsPath & strFile Debug.Print "File and path: " & strFileAndPath

On Error Resume Next

Check whether this file already exists in the folder, and save it to the folder if not

Set fil = fso.GetFile(strFileAndPath) If fil Is Nothing Then

Save this attachment to a file in the Output Docs folder.

att.SaveAsFile strFileAndPath End If

On Error GoTo ErrorHandler

Load this attachment to the Attachments field of the target table.

With rstTargetAttachments .AddNew

.Fields("FileData").LoadFromFile _

(strFileAndPath) .Update End With

Kill strFileAndPath Next att

ErrorHandlerExit: Exit Sub

ErrorHandler:

& "; Description: " & Err.Description Resume ErrorHandlerExit

End Sub

Public Sub CopyAccessAttsToAccess(rstSourceAttachments _ As DAO.Recordset2, rstTargetAttachments _ As DAO.Recordset2) 'Called from CreateDenormalizedContactsTable, 'UpdateAllAccessContacts, UpdateOutlookContactID, 'UpdateAccessContactID, UpdateOutlookContactName, 'UpdateAccessContactName, UpdateAllAccessContacts, 'UpdateOutlookContactID, cboAttachments_Click on 'fsubCopyFieldData

On Error GoTo ErrorHandler

Set fso = CreateObject("Scripting.FileSystemObject")

Do While Not rstSourceAttachments.EOF

Need to extract the file name from the FileName field, using the SplitFileName function, because it sometimes contains the path (sometimes multiple times) as well as the file name.

SplitFileName(rstSourceAttachments.Fields("FileName")) Debug.Print "File name: " & strFile strFileAndPath = strDocsPath & strFile Debug.Print "File and path: " & strFileAndPath

On Error Resume Next

Check whether this file already exists in the folder, and save it to the folder if not.

Set fil = fso.GetFile(strFileAndPath) If fil Is Nothing Then

Save this attachment to a file in the Output Docs folder.

rstSourceAttachments.Fields("FileData").SaveToFile _

strFileAndPath Debug.Print "Saving " & strFileAndPath End If

Load this attachment to the Attachments field of the target table. rstTargetAttachments.AddNew rstTargetAttachments.Fields("FileData").LoadFromFile _

(strFileAndPath) rstTargetAttachments.Update Kill strFileAndPath rstSourceAttachments.MoveNext

Loop rstSourceAttachments.Close rstTargetAttachments.Close

ErrorHandlerExit: Exit Sub

ErrorHandler:

If Err.Number = 3839 Then

'File already exists; delete it Kill strFileAndPath Resume Else

& "; Description: " & Err.Description Resume ErrorHandlerExit End If

End Sub

Function SplitFileName(strFileAndPath) As String

On Error GoTo ErrorHandler

Dim strFullPath() As String Dim intUBound As Integer

Extract the file name from the variable with the file and path.

strFullPath = Split(strFileAndPath, -1, vbTextCompare)

intUBound = UBound(strFullPath) strFile = strFullPath(intUBound) SplitFileName = strFile

ErrorHandlerExit: Exit Function

ErrorHandler:

MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description

Resume ErrorHandlerExit

End Function

Figure 11.16 shows an Outlook contact with an attachment created from an Access contact record.

FIGURE 11.16

An Outlook contact with an attachment created from an Access contact record.

FIGURE 11.16

0 0

Post a comment