Hi,
to send the attachments, you first need to save them to a folder, and from there you can attach them to your message.
Here are two routines, the first one is for the command button on your form, the second one saves the file(s) to a folder and returns an array with full path and filename to be used for creating the mail message.
Of course you'll need to change some parameters to have it up and running in your database.
As I'm using the outlook object and filesystem object, you need to set reference to the outlook library and the Microsoft Scripting runtime library.
After running the code you'll have a concept email message in your outlook box.
Code:
Private Sub cmd_SendMail_Click()
Dim recID As Long
Dim vFileNames As Variant
Dim i As Integer
Dim OutlookObject As Object
Dim myNameSpace
Dim Drafts As MAPIFolder
Dim MailMessage As Object
'ID = the id-field, change to the correct name of your table id on the form you're using
recID = Me.Id.Value
vFileNames = SaveAttToFileSys(recID) 'creates array with filenames and saves the files to a temp folder
Set OutlookObject = CreateObject("Outlook.Application")
Set myNameSpace = OutlookObject.GetNamespace("MAPI")
Set Drafts = myNameSpace.GetDefaultFolder(olFolderDrafts)
Set MailMessage = OutlookObject.CreateItem(olMailItem)
With MailMessage
.to = "" 'here you need to substitute the value of the field holding the email address
.Subject = "The subject of your message"
'add the attachments
For i = 0 To UBound(vFileNames)
.Attachments.Add (vFileNames(i))
Next i
.Body = "Sometext here"
.Save 'change to send if you want to send the mail directly
End With
Set MailMessage = Nothing
Set OutlookObject = Nothing
Set myNameSpace = Nothing
Set Drafts = Nothing
End Sub
Code:
Option Compare Database
Option Explicit
Public Function SaveAttToFileSys(ByVal recID As Long) As Variant
'Saves attachment to a folder and returns an array with full path and name to the files
Const sTempDir As String = "M:\TempFiles\"
Const sAttachmentFldName As String = "TheFieldNameWithAttachments"
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim RsAtt As DAO.Recordset2
Dim fldAtt As DAO.Field2
Dim sFileNames() As String
Dim iFileCnt As Integer
Dim sSQL As String
sSQL = "SELECT Id, TheFieldNameWithAttachments " _
& "FROM YourTableName " _
& "Where ID = " & recID
'Create a filesys object to check if attachments are already saved to the tempdir
Dim fso As New FileSystemObject
Dim fFile As File
Set db = CurrentDb
Set rs = db.OpenRecordset(sSQL)
With rs
.MoveFirst
Do Until .EOF
Set fldAtt = .Fields(sAttachmentFldName)
'make sure that the field is a multi value field
If fldAtt.IsComplex Then
Set RsAtt = fldAtt.Value
End If
'loop the values of the attachment field
Do While Not RsAtt.EOF
'Write filepath to array
ReDim Preserve sFileNames(iFileCnt)
sFileNames(iFileCnt) = sTempDir & RsAtt.Fields("FileName").Value
'test if file already exists in temp folder, if so delete
With fso
If .FileExists(sFileNames(iFileCnt)) Then
.DeleteFile (sFileNames(iFileCnt))
End If
End With
iFileCnt = iFileCnt + 1
'save attachment to the temp dir
RsAtt.Fields("FileData").SaveToFile sTempDir
RsAtt.MoveNext
Loop
.MoveNext
Loop
End With
SaveAttToFileSys = sFileNames
rs.Close
Set rs = Nothing
Set RsAtt = Nothing
End Function
